From 945ee705c3cc674c8335b75df8408bc3acb8a78f Mon Sep 17 00:00:00 2001 From: Petr Baudis Date: Wed, 29 Aug 2012 03:52:30 +0200 Subject: [PATCH] Initial implementation of brmbar v3 - brmbar v1 emulator brmbar-cli.pl Uses PostgreSQL to store accounts and transactions, and Perl + Moose for the implementation. The schema is somewhat complicated, but brmburo-compatible; accounting design by TMA. --- brmbar3/BrmBar/Account.pm | 121 +++++++++++++++++++++++++++++++++++ brmbar3/BrmBar/Currency.pm | 126 +++++++++++++++++++++++++++++++++++++ brmbar3/BrmBar/SQL.pm | 20 ++++++ brmbar3/BrmBar/Shop.pm | 73 +++++++++++++++++++++ brmbar3/SQL | 79 +++++++++++++++++++++++ brmbar3/SQL.test | 22 +++++++ brmbar3/brmbar-cli.pl | 80 +++++++++++++++++++++++ 7 files changed, 521 insertions(+) create mode 100644 brmbar3/BrmBar/Account.pm create mode 100644 brmbar3/BrmBar/Currency.pm create mode 100644 brmbar3/BrmBar/SQL.pm create mode 100644 brmbar3/BrmBar/Shop.pm create mode 100644 brmbar3/SQL create mode 100644 brmbar3/SQL.test create mode 100755 brmbar3/brmbar-cli.pl diff --git a/brmbar3/BrmBar/Account.pm b/brmbar3/BrmBar/Account.pm new file mode 100644 index 0000000..211d385 --- /dev/null +++ b/brmbar3/BrmBar/Account.pm @@ -0,0 +1,121 @@ +package BrmBar::Account; + +use strict; +use warnings; +use v5.10; + +use utf8; +use encoding::warnings; +use open qw(:encoding(UTF-8)); + +use Moose; +use Carp; + +has 'db' => (is => 'ro', isa => 'DBI::db', required => 1); +has 'id' => (is => 'ro', isa => 'Int'); +has 'name' => (is => 'ro', isa => 'Str'); +has 'acctype' => (is => 'ro', isa => 'Str'); +has 'currency' => (is => 'ro', isa => 'BrmBar::Currency'); + + +sub load_by_barcode { + my ($class, %opts) = @_; + + defined $opts{db} or croak "db parameter missing"; + + my $q = $opts{db}->prepare('SELECT account FROM barcodes WHERE barcode = ?'); + $q->execute($opts{barcode}); + ($opts{id}) = $q->fetchrow_array(); + defined $opts{id} or return undef; + + delete $opts{barcode}; + return $class->load(%opts); +} + +# Constructor for existing account +sub load { + my ($class, %opts) = @_; + + defined $opts{db} or croak "db parameter missing"; + + if (defined $opts{id}) { + my $q = $opts{db}->prepare('SELECT name FROM accounts WHERE id = ?'); + $q->execute($opts{id}); + ($opts{name}) = $q->fetchrow_array(); + + } elsif (defined $opts{name}) { + my $q = $opts{db}->prepare('SELECT id FROM accounts WHERE name = ?'); + $q->execute($opts{name}); + ($opts{id}) = $q->fetchrow_array(); + } + + my $q = $opts{db}->prepare('SELECT currency, acctype FROM accounts WHERE id = ?'); + $q->execute($opts{id}); + @opts{'currency', 'acctype'} = $q->fetchrow_array(); + + $opts{currency} = BrmBar::Currency->load(db => $opts{db}, id => $opts{currency}); + + my $self = $class->new(%opts); + return $self; +} + +# Constructor for new account +sub create { + my ($class, %opts) = @_; + + defined $opts{db} or croak "db parameter missing"; + defined $opts{name} or croak "name parameter missing"; + defined $opts{currency} or croak "currency parameter missing"; + defined $opts{acctype} or croak "acctype parameter missing"; + + my $q = $opts{db}->prepare('INSERT INTO accounts (name, currency, acctype) VALUES (?, ?, ?) RETURNING id'); + $q->execute($opts{name}, $opts{currency}->id(), $opts{acctype}); + ($opts{id}) = $q->fetchrow_array(); + + my $self = $class->new(%opts); + return $self; +} + +sub balance { + my ($self) = @_; + + my $q = $self->db()->prepare('SELECT SUM(amount) FROM transaction_splits WHERE account = ? AND side = ?'); + + $q->execute($self->id(), 'debit'); + my ($debit) = $q->fetchrow_array; + $debit ||= 0; + + $q->execute($self->id(), 'credit'); + my ($credit) = $q->fetchrow_array; + $credit ||= 0; + + return ($debit - $credit); +} + +sub balance_str { + my ($self) = @_; + return $self->currency()->str($self->balance()); +} + +sub negbalance_str { + my ($self) = @_; + return $self->currency()->str(-$self->balance()); +} + +sub debit { + my ($self, $tr, $amount, $memo) = @_; + $self->_transaction_split($tr, 'debit', $amount, $memo); +} + +sub credit { + my ($self, $tr, $amount, $memo) = @_; + $self->_transaction_split($tr, 'credit', $amount, $memo); +} + +# Common part of credit(), debit() +sub _transaction_split { + my ($self, $tr, $side, $amount, $memo) = @_; + $self->db()->prepare('INSERT INTO transaction_splits (transaction, side, account, amount, memo) VALUES (?, ?, ?, ?, ?)')->execute($tr, $side, $self->id(), $amount, $memo); +} + +1; diff --git a/brmbar3/BrmBar/Currency.pm b/brmbar3/BrmBar/Currency.pm new file mode 100644 index 0000000..e74adc5 --- /dev/null +++ b/brmbar3/BrmBar/Currency.pm @@ -0,0 +1,126 @@ +package BrmBar::Currency; + +use strict; +use warnings; +use v5.10; + +use utf8; +use encoding::warnings; +use open qw(:encoding(UTF-8)); + +use Moose; +use Carp; + +has 'db' => (is => 'ro', isa => 'DBI::db', required => 1); +has 'id' => (is => 'ro', isa => 'Int'); +has 'name' => (is => 'ro', isa => 'Str'); + + +# Default wallet currency +sub default { + my ($class, %opts) = @_; + + return $class->load(db => $opts{db}, name => 'Kč'); +} + +# Constructor for existing currency +sub load { + my ($class, %opts) = @_; + + defined $opts{db} or croak "db parameter missing"; + + if (defined $opts{id}) { + my $q = $opts{db}->prepare('SELECT name FROM currencies WHERE id = ?'); + $q->execute($opts{id}); + ($opts{name}) = $q->fetchrow_array(); + + } elsif (defined $opts{name}) { + my $q = $opts{db}->prepare('SELECT id FROM currencies WHERE name = ?'); + $q->execute($opts{name}); + ($opts{id}) = $q->fetchrow_array(); + } + + my $self = $class->new(%opts); + return $self; +} + +# Constructor for new currency +sub create { + my ($class, %opts) = @_; + + defined $opts{db} or croak "db parameter missing"; + defined $opts{name} or croak "name parameter missing"; + + my $q = $opts{db}->prepare('INSERT INTO currencies (name) VALUES (?) RETURNING id'); + $q->execute($opts{name}); + ($opts{id}) = $q->fetchrow_array(); + + my $self = $class->new(%opts); + return $self; +} + + +# Set exchange rate against $other (BrmBar::Currency): +# $buy is the price of $self in means of $other when buying it (into brmbar) +# $sell is the price of $self in means of $other when selling it (from brmbar) +sub set_rate { + my ($self, $other, $buy, $sell) = @_; + + my $qs = $self->db()->prepare("SELECT rate FROM exchange_rates WHERE target = ? AND source = ?"); + my $qu = $self->db()->prepare("UPDATE exchange_rates SET rate = ?, rate_dir = ? WHERE target = ? AND source = ?"); + my $qi = $self->db()->prepare("INSERT INTO exchange_rates (target, source, rate, rate_dir) VALUES (?, ?, ?, ?)"); + + $qs->execute($self->id(), $other->id()); + if ($qs->fetchrow_array) { + $qu->execute($buy, 'target_to_source'); + } else { + $qi->execute($self->id(), $other->id(), $buy, 'target_to_source'); + } + + $qs->execute($other->id(), $self->id()); + if ($qs->fetchrow_array) { + $qu->execute($sell, 'source_to_target'); + } else { + $qi->execute($other->id(), $self->id(), $sell, 'source_to_target'); + } +} + +# Return ($buy, $sell) rates of $self in relation to $other (BrmBar::Currency): +# $buy is the price of $self in means of $other when buying it (into brmbar) +# $sell is the price of $self in means of $other when selling it (from brmbar) +sub rates { + my ($self, $other) = @_; + + my $qs = $self->db()->prepare("SELECT rate, rate_dir FROM exchange_rates WHERE target = ? AND source = ?"); + + $qs->execute($self->id(), $other->id()); + my ($buy_rate, $buy_rate_dir) = $qs->fetchrow_array; + defined $buy_rate or croak "unknown conversion ".$other->name()." to ".$self->name(); + my $buy = $buy_rate_dir eq 'target_to_source' ? $buy_rate : 1/$buy_rate; + + $qs->execute($other->id(), $self->id()); + my ($sell_rate, $sell_rate_dir) = $qs->fetchrow_array; + defined $sell_rate or croak "unknown conversion ".$self->name()." to ".$other->name(); + my $sell = $sell_rate_dir eq 'source_to_target' ? $sell_rate : 1/$sell_rate; + + return ($buy, $sell); +}; + +sub convert { + my ($self, $amount, $target) = @_; + + my $q = $self->db()->prepare("SELECT rate, rate_dir FROM exchange_rates WHERE target = ? AND source = ? AND valid_since <= NOW() ORDER BY valid_since ASC LIMIT 1"); + $q->execute($target->id(), $self->id()); + my ($rate, $rate_dir) = $q->fetchrow_array(); + + defined $rate or croak "unknown conversion ".$self->name()." to ".$target->name(); + + return $rate_dir eq 'source_to_target' ? $amount * $rate : $amount / $rate; +} + +sub str { + my ($self, $amount) = @_; + return $amount . ' ' . $self->name(); +} + +1; diff --git a/brmbar3/BrmBar/SQL.pm b/brmbar3/BrmBar/SQL.pm new file mode 100644 index 0000000..a124a34 --- /dev/null +++ b/brmbar3/BrmBar/SQL.pm @@ -0,0 +1,20 @@ +package BrmBar::SQL; + +use warnings; +use strict; +use v5.10; + +use utf8; +use encoding::warnings; +use open qw(:encoding(UTF-8)); + +use DBI; + +sub init { + my ($sqlconf) = @_; + my $db = DBI->connect("dbi:Pg:dbname=brmbar", '', '', {AutoCommit => 1, RaiseError => 1, pg_enable_utf8 => 1}) + or die "Cannot open db: ".DBI->errstr; + $db; +} + +1; diff --git a/brmbar3/BrmBar/Shop.pm b/brmbar3/BrmBar/Shop.pm new file mode 100644 index 0000000..27c1dfd --- /dev/null +++ b/brmbar3/BrmBar/Shop.pm @@ -0,0 +1,73 @@ +package BrmBar::Shop; + +use strict; +use warnings; +use v5.10; + +use utf8; +use encoding::warnings; +use open qw(:encoding(UTF-8)); + +use Moose; +use Carp; + +use BrmBar::Currency; +use BrmBar::Account; + +has 'db' => (is => 'ro', isa => 'DBI::db', required => 1); +has 'currency' => (is => 'rw', isa => 'BrmBar::Currency'); +has 'profits' => (is => 'ro', isa => 'BrmBar::Account'); # income account for our margins +has 'cash' => (is => 'ro', isa => 'BrmBar::Account'); # our operational ("wallet") cash account + +sub new_with_defaults { + my ($class, %opts) = @_; + + return $class->new( + db => $opts{db}, + currency => BrmBar::Currency->default(db => $opts{db}), + profits => BrmBar::Account->load(db => $opts{db}, name => 'BrmBar Profits'), + cash => BrmBar::Account->load(db => $opts{db}, name => 'BrmBar Cash') + ); +} + + +sub sell { + my ($self, %opts) = @_; + my ($item, $user, $amount) = @opts{'item', 'user', 'amount'}; + $amount ||= 1; + + my ($buy, $sell) = $item->currency()->rates($self->currency()); + my $cost = $amount * $sell; + my $profit = $amount * ($sell - $buy); + + $self->db()->begin_work(); + my $tr = $self->_transaction(responsible => $user, description => 'BrmBar sale of '.$amount.'x '.$item->name().' to '.$user->name()); + $item->credit($tr, $amount, $user->name()); + $user->debit($tr, $cost, $item->name()); # debit (increase) on a _debt_ account + $self->profits()->debit($tr, $profit, "Margin on ".$item->name()); + $self->db()->commit(); + + return $cost; +} + +sub add_credit { + my ($self, %opts) = @_; + my ($credit, $user) = @opts{'credit', 'user'}; + + $self->db()->begin_work(); + my $tr = $self->_transaction(responsible => $user, description => 'BrmBar credit replenishment for '.$user->name()); + $self->cash()->debit($tr, $credit, $user->name()); + $user->credit($tr, $credit, 'Credit replenishment'); + $self->db()->commit(); +} + + +# This is for internal usage of the business logic +sub _transaction { + my ($self, %opts) = @_; + my ($responsible, $description) = @opts{'responsible', 'description'}; + + $self->db()->prepare('INSERT INTO transactions (responsible, description) VALUES (?, ?)')->execute($responsible->id(), $description); +} + +1; diff --git a/brmbar3/SQL b/brmbar3/SQL new file mode 100644 index 0000000..b7bee49 --- /dev/null +++ b/brmbar3/SQL @@ -0,0 +1,79 @@ +CREATE SEQUENCE currencies_id_seq START WITH 1 INCREMENT BY 1; +CREATE TABLE currencies ( + id INTEGER PRIMARY KEY NOT NULL DEFAULT NEXTVAL('currencies_id_seq'::regclass), + name VARCHAR(128) NOT NULL +); +INSERT INTO currencies (name) VALUES ('Kč'); + +CREATE TYPE exchange_rate_direction AS ENUM ('source_to_target', 'target_to_source'); +CREATE TABLE exchange_rates ( + valid_since TIMESTAMP WITHOUT TIME ZONE DEFAULT NOW() NOT NULL, + + target INTEGER NOT NULL, + FOREIGN KEY (target) REFERENCES currencies (id), + + source INTEGER NOT NULL, + FOREIGN KEY (source) REFERENCES currencies (id), + + rate DECIMAL(12,2) NOT NULL, + rate_dir exchange_rate_direction NOT NULL +); + + +-- brmbar users have 'debt' accounts; a negative balance means that +-- we have debt to the users, i.e. they are positive relative to the brmbar. +-- Positive balance means that the users have debt in brmbar. +-- Therefore, user's balance must always be shown negated. +CREATE SEQUENCE accounts_id_seq START WITH 1 INCREMENT BY 1; +CREATE TYPE account_type AS ENUM ('cash', 'debt', 'inventory', 'income', 'expense', 'starting_balance', 'ending_balance'); +CREATE TABLE accounts ( + id INTEGER PRIMARY KEY NOT NULL DEFAULT NEXTVAL('accounts_id_seq'::regclass), + + name VARCHAR(128) NOT NULL, + + currency INTEGER NOT NULL, + FOREIGN KEY (currency) REFERENCES currencies (id), + + acctype account_type NOT NULL +); +INSERT INTO accounts (name, currency, acctype) VALUES ('BrmBar Cash', (SELECT id FROM currencies WHERE name='Kč'), 'cash'); +INSERT INTO accounts (name, currency, acctype) VALUES ('BrmBar Profits', (SELECT id FROM currencies WHERE name='Kč'), 'income'); + + +CREATE SEQUENCE barcodes_id_seq START WITH 1 INCREMENT BY 1; +CREATE TABLE barcodes ( + barcode VARCHAR(128) PRIMARY KEY NOT NULL, + + account INTEGER NOT NULL, + FOREIGN KEY (account) REFERENCES accounts (id) +); + + +CREATE SEQUENCE transactions_id_seq START WITH 1 INCREMENT BY 1; +CREATE TABLE transactions ( + id INTEGER PRIMARY KEY NOT NULL DEFAULT NEXTVAL('transactions_id_seq'::regclass), + time TIMESTAMP DEFAULT NOW() NOT NULL, + + responsible INTEGER, + FOREIGN KEY (responsible) REFERENCES accounts (id), + -- FIXME: imperfect constraint to assure this is a user + + description TEXT +); + +CREATE SEQUENCE transaction_splits_id_seq START WITH 1 INCREMENT BY 1; +CREATE TYPE transaction_split_side AS ENUM ('credit', 'debit'); +CREATE TABLE transaction_splits ( + id INTEGER PRIMARY KEY NOT NULL DEFAULT NEXTVAL('transaction_splits_id_seq'::regclass), + + transaction INTEGER NOT NULL, + FOREIGN KEY (transaction) REFERENCES transactions (id), + + side transaction_split_side NOT NULL, + + account INTEGER NOT NULL, + FOREIGN KEY (account) REFERENCES accounts (id), + amount DECIMAL(12,2) NOT NULL, + + memo TEXT +); diff --git a/brmbar3/SQL.test b/brmbar3/SQL.test new file mode 100644 index 0000000..f655c73 --- /dev/null +++ b/brmbar3/SQL.test @@ -0,0 +1,22 @@ +-- Few test inserts just for debugging, to be used on clean database + +INSERT INTO accounts (name, currency, acctype) VALUES ('pasky', 1, 'debt'); +INSERT INTO barcodes (barcode, account) VALUES ('pasky', (SELECT id FROM accounts WHERE name = 'pasky')); +INSERT INTO accounts (name, currency, acctype) VALUES ('TMA', 1, 'debt'); +INSERT INTO barcodes (barcode, account) VALUES ('TMA', (SELECT id FROM accounts WHERE name = 'TMA')); + +INSERT INTO currencies (name) VALUES ('Club Mate'); +INSERT INTO accounts (name, currency, acctype) VALUES ('Club Mate', (SELECT id FROM currencies WHERE name = 'Club Mate'), 'inventory'); +INSERT INTO exchange_rates (target, source, rate, rate_dir) VALUES ((SELECT id FROM currencies WHERE name = 'Club Mate'), (SELECT id FROM currencies WHERE name = 'Kč'), 28, 'target_to_source'); +INSERT INTO exchange_rates (target, source, rate, rate_dir) VALUES ((SELECT id FROM currencies WHERE name = 'Kč'), (SELECT id FROM currencies WHERE name = 'Club Mate'), 35, 'source_to_target'); +INSERT INTO barcodes (barcode, account) VALUES ('42', (SELECT id FROM accounts WHERE name = 'Club Mate')); + +INSERT INTO currencies (name) VALUES ('Deli'); +INSERT INTO accounts (name, currency, acctype) VALUES ('Deli', (SELECT id FROM currencies WHERE name = 'Deli'), 'inventory'); +INSERT INTO exchange_rates (target, source, rate, rate_dir) VALUES ((SELECT id FROM currencies WHERE name = 'Deli'), (SELECT id FROM currencies WHERE name = 'Kč'), 7.50, 'target_to_source'); +INSERT INTO exchange_rates (target, source, rate, rate_dir) VALUES ((SELECT id FROM currencies WHERE name = 'Kč'), (SELECT id FROM currencies WHERE name = 'Deli'), 10, 'source_to_target'); +INSERT INTO barcodes (barcode, account) VALUES ('43', (SELECT id FROM accounts WHERE name = 'Deli')); + +INSERT INTO transactions (responsible, description) VALUES ((SELECT id FROM accounts WHERE name = 'pasky'), 'Naskladnena krabice Deli'); +INSERT INTO transaction_splits (transaction, side, account, amount, memo) VALUES (1, 'credit', (SELECT id FROM accounts WHERE name = 'pasky'), 75, '10x Deli'); +INSERT INTO transaction_splits (transaction, side, account, amount, memo) VALUES (1, 'debit', (SELECT id FROM accounts WHERE name = 'Deli'), 10, 'pasky'); diff --git a/brmbar3/brmbar-cli.pl b/brmbar3/brmbar-cli.pl new file mode 100755 index 0000000..81020bc --- /dev/null +++ b/brmbar3/brmbar-cli.pl @@ -0,0 +1,80 @@ +#!/usr/bin/perl -CSA + +use warnings; +use strict; +use v5.10; + +use utf8; +use encoding::warnings; +use open qw(:encoding(UTF-8)); + +use lib qw(.); +use BrmBar::SQL; +use BrmBar::Account; +use BrmBar::Shop; + +my $db = BrmBar::SQL->init(); +my $shop = BrmBar::Shop->new_with_defaults(db => $db); +my $currency = $shop->currency(); + +my ($active_inv_item, $active_credit); + +while (<>) { + chomp; + my $barcode = $_; + + if ($barcode =~ /^\$/) { + # Credit replenishment + my %credits = ('$02' => 20, '$05' => 50, '$10' => 100, '$20' => 200, '$50' => 500, '$1k' => 1000); + my $credit = $credits{$barcode}; + if (not defined $credit) { + say("Unknown barcode: $barcode"); + next; + } + + undef $active_inv_item; + $active_credit = $credit; + next; + } + + if ($barcode eq 'SCR') { + say("SHOW CREDIT"); + undef $active_inv_item; + undef $active_credit; + # In next iteration, person's barcode will for sure not be charged anything + next; + } + + my $acct = BrmBar::Account->load_by_barcode(db => $db, barcode => $barcode); + if (not $acct) { + say("Unknown barcode: $barcode"); + next; + } + + if ($acct->acctype() eq 'debt') { + if (defined $active_inv_item) { + my $cost = $shop->sell(item => $active_inv_item, user => $acct); + say($acct->name()." has bought ".$active_inv_item->name()." for ".$currency->str($cost)." and now has ".$acct->negbalance_str()." balance"); + } elsif (defined $active_credit) { + $shop->add_credit(credit => $active_credit, user => $acct); + say($acct->name()." has added ".$currency->str($active_credit)." credit"); + } else { + say($acct->name()." has ".$acct->negbalance_str()." balance"); + } + + undef $active_inv_item; + undef $active_credit; + + } elsif ($acct->acctype() eq 'inventory') { + my ($buy, $sell) = $acct->currency()->rates($currency); + say($acct->name()." costs ".$currency->str($sell)." with ".$acct->balance()." in stock"); + + $active_inv_item = $acct; + undef $active_credit; + + } else { + say("invalid account type ".$acct->acctype()); + undef $active_inv_item; + undef $active_credit; + } +}