diff --git a/TrsrDB/HTTP.pm b/TrsrDB/HTTP.pm index 254ef9f..d1bfa0c 100644 --- a/TrsrDB/HTTP.pm +++ b/TrsrDB/HTTP.pm @@ -97,12 +97,14 @@ sub startup { my $c = shift; return $c->stash('grade') > 1 || undef; }); + $admin->any('/admin')->to('admin#dash'); $admin->any( [qw/GET POST/] => '/account/:account' => { account => undef }) ->to('account#upsert'); $admin->any( [qw/GET POST/] => '/:account/in')->to('credit#upsert'); $admin->any( [qw/GET POST/] => '/:account/out')->to('debit#upsert'); $admin->post('/:account/transfer')->to('account#transfer'); + $admin->any( [qw/GET POST/] => '/batch-processor' )->to('account#batch_processor'); $admin->any( [qw/GET POST PATCH/] => '/credit/:id' )->to('credit#upsert'); $admin->any( [qw/GET POST/] => '/credit')->to('credit#upsert'); $admin->any( [qw/GET POST PATCH/] => '/debit/*id' )->to('debit#upsert'); diff --git a/TrsrDB/HTTP/Account.pm b/TrsrDB/HTTP/Account.pm index 8368751..f6c92b9 100644 --- a/TrsrDB/HTTP/Account.pm +++ b/TrsrDB/HTTP/Account.pm @@ -3,6 +3,7 @@ use strict; package TrsrDB::HTTP::Account; use Mojo::Base 'Mojolicious::Controller'; use Carp qw(croak); +use FindBin qw($Bin); sub list { my $self = shift; @@ -79,6 +80,25 @@ sub upsert { return; } +sub batch_processor { + my $self = shift; + + if ( $self->req->method eq 'POST' ) { + my $text = $self->req->headers->content_type =~ m{^text/plain\b} + ? $self->req->body + : $self->param("batch") + ; + open my $fh, '<', \$text; + require "$Bin/trsr" or die; + $self->app->db->storage->txn_do(sub { + Commands::act_on_other_db($self->app->db); + Commands::charge_account($fh); + }); + $self->redirect_to('home'); + } + +} + sub history { my $self = shift; my %query = ( account => $self->stash("account") ); diff --git a/site/style.css b/site/style.css index 957e7ab..88b0181 100644 --- a/site/style.css +++ b/site/style.css @@ -58,7 +58,8 @@ table td.mark { background-color:rgba(255,0,0,0.1); } -table td input { +table td input, +textarea { width:100%; box-sizing: border-box; } diff --git a/templates/account/list.html.ep b/templates/account/list.html.ep index 8b15d12..d5aca60 100644 --- a/templates/account/list.html.ep +++ b/templates/account/list.html.ep @@ -36,7 +36,7 @@ % } # while -% stash links => [ '/account' => "Create account", '/bankStatement' => "Reconstructed bank statement" ]; +% stash links => [ '/account' => "Create account", '/batch-processor' => "Batch Processor", '/bankStatement' => "Reconstructed bank statement" ]; % stash help => $_ for begin

Column explanation

diff --git a/test.sh b/test.sh deleted file mode 100755 index 96a9eff..0000000 --- a/test.sh +++ /dev/null @@ -1,20 +0,0 @@ -#!/bin/bash - -abort () { - echo Database not deleted. - exit ${1:-1} -} - -db=$(mktemp -t trsr-XXXXXXXXX.db); -bash t/schema.sh $db -if [ $? == 0 ]; then - echo Tests passed. -else abort -fi - -> $db; sqlite3 $db < schema.sql -export TRSRDB_SQLITE_FILE=$db -if prove -r t; then - rm $db -else abort $? -fi diff --git a/trsr b/trsr index 090abbb..a992634 100755 --- a/trsr +++ b/trsr @@ -1,58 +1,22 @@ #!/usr/bin/env perl use strict; +my (%OPTS, $ACCOUNT, %targets); + +package Commands { +use Text::Wrap qw(wrap); +use Carp qw(croak); +use Scalar::Util qw(openhandle); + my $db; use TrsrDB \$db; use open qw/:std :encoding(utf8)/; -my %dispatcher = ( - charge => \&Commands::charge_account, - ct => sub { - Commands::charge_account(); - Commands::make_transfers(); - }, - cts => sub { - Commands::charge_account(); - Commands::make_transfers(); - Commands::balance_status(); - }, - ctr => sub { - Commands::charge_account(); - Commands::make_transfers(); - Commands::balance_status(1); - }, - report => sub { - Commands::balance_status(1); - }, - status => \&Commands::balance_status, - transfer => \&Commands::make_transfers, - tr => sub { - Commands::make_transfers(); - Commands::balance_status(1); - }, - ts => sub { - Commands::make_transfers(); - Commands::balance_status(); - } -); +sub act_on_other_db { + $db = shift; +} -package Commands; -use Text::Wrap qw(wrap); -use Carp qw(croak); - -use Getopt::Long; - -my %targets; -my %OPTS = ( - 'account' => \my $ACCOUNT, - 'target-credit' => \%targets -); -GetOptions( \%OPTS, - '1', 'account|a=s', 'target|t=s', 'target-credit|tcr=i', 'source|s=s', - 'date|d=s', 'value|v=i', 'purpose|p=s', 'bill-id|b=s' -); - -sub _single_charge { +sub single_charge { my $accounts = $db->resultset("Account"); _require_value(); @@ -64,7 +28,7 @@ sub _single_charge { my $charger = sub { my ($account, $billId) = @_; - my $what = $billId ? 'add_to_debit' : 'add_to_credit'; + my $what = $billId ? 'add_to_debits' : 'add_to_credits'; return $account->$what({ $billId ? ( billId => $billId, @@ -81,14 +45,16 @@ sub _single_charge { $db->make_transfers( $record->ID => $t ); } } + elsif ( $billId =~ s{ @(\w+) }{ %s }xms ) { $accounts = $accounts->search({ type => $1 }); while ( my $account = $accounts->next ) { - $charger->( $account, sprintf $billId, $account->ID ); + $charger->( $account, sprintf $billId ); } } + else { - die "Sorry, you haven't specified account(s) to charge"; + croak "You haven't specified an account to charge"; } } @@ -168,48 +134,46 @@ sub _require_target { } sub charge_account { - goto &_single_charge if $OPTS{1}; + goto &single_charge if $OPTS{1}; print "Enter records ...\n"; + local *ARGV = openhandle($_[0]) + // croak "charge_account() expects open file handle to read from" + if exists $_[0]; + # Possible line formats: # ------------------------------------------------------- - # Date Account Var Purpose :: Target credit (TCr) - # Date Account +Amount Purpose :: Payment Credit - # Date Account -Amount TCr ID Purpose :: Bill - # Date Account ) ) { - chomp $line; _strip_comment_from($line) // next; - my ($date, $account, $amount, $purpose) = $ACCOUNT - ? do { my @columns = split /[,\s]\s*/, $line, 3; + my ($date, $account, $debit, $credit, $purpose) = $ACCOUNT + ? do { my @columns = split /[,\s]\s*/, $line, 4; splice @columns, 1, 0, $ACCOUNT; - @columns } - : split /[,\s]\s*/, $line, 4 + @columns + } + : split /[,\s]\s*/, $line, 5 ; $account = $db->resultset("Account")->find($account) // die "User not found: $account\n"; - if ( $amount =~ m{^[a-z]}i ) { - _append_adj_lines_to($purpose); - my $r = record_credit($date, $account, $purpose, 0); - $targets{ $amount } = $r->credId; - } - elsif ( $amount =~ s/^([<-])// ) { + _append_adj_lines_to($purpose); - (my ($tgt, $billId), $purpose) - = $1 eq q{<} ? (undef, split /\s+/, $purpose, 2) - : (split /\s+/, $purpose, 3) - ; + if ( $debit =~ /^\d/ ) { - _append_adj_lines_to($purpose); - - $DB::single=1; + my $tgt = $credit; + my $billId = $purpose =~ s{ \A ([[:print:]]+?) : \s* }{}xms + ? $1 + : croak qq{Missing ID in debit purpose: $purpose} + ; if ( $purpose =~ s{ \s* << \s* (.+?) \r? \n? \z }{}xms ) { push @transfers, [ @@ -217,45 +181,59 @@ sub charge_account { ] => $billId; } - if ( my ($var, $account) = $tgt =~ m{^([A-Za-z]\w+)([?=]\w+)$} ) { - my $op = substr $account, 0, 1; + if ( my ($var, $op, $assigned) + = $tgt =~ m{^([A-Za-z]\w+)([?=])(\d+)$} + ) { if ( $op eq q{=} ) { - $tgt = $targets{ $var } = $account; + $tgt = $targets{ $var } = $assigned; } else { - print "Please select target credit to reference by $var:\n", - "-------------------------------------------------\n"; - $tgt = $targets{ $var } - = select_target_credit_from($account); + $tgt = select_target_credit_from($assigned, $var); } } elsif ( $tgt =~ /^[a-z]/i ) { $tgt = $targets{ $tgt } - // croak "Target credit not declared: $tgt!\n"; + // croak "Target credit not assigned: $tgt!\n"; } - record_debit( - $date, $account, $billId, $purpose, - integer_money_value($amount), $tgt - ); - + + $account->add_to_debits({ + billId => $billId, + date => $date, + purpose => $purpose, + value => integer_money_value($debit), + targetCredit => $tgt, + }); + } - elsif ( ($amount) = $amount =~ m{ \A \+? (\d+) \z }xms ) { - my $tgt = $purpose =~ s{ \s* >> \s* (.+) \z }{}xms && $1; - _append_adj_lines_to($purpose); - my $c = record_credit( - $date, $account, $purpose, integer_money_value($amount) - ); + + elsif ( $credit =~ /^\d/ ) { + + my $tgt = $purpose =~ s{ \s* >> \s* (.+) \r? \n? \z }{}xms && $1; + + my $c = $account->add_to_credits({ + date => $date, + account => $account, + purpose => $purpose, + value => integer_money_value($credit) + }); + + if ( $debit =~ /^[a-z]/i ) { $targets{ $debit } = $c->credId; } + elsif ( $debit ne q{+} ) { + croak "Invalid field input: $debit neither number nor name"; + } + push @transfers, $c->credId => $tgt if $tgt; + } else { - die "Amount cannot be parsed: $amount\n"; + die "Cannot be parsed: $debit $credit\n"; } } if ( @transfers ) { my $t = $db->make_transfers( @transfers ); if ( $t ) { - printf "Transferred %f in total.\n", $t; + printf "Transferred %d in total.\n", $t; } else { print "No transfers could be made.\n"; @@ -281,9 +259,11 @@ sub integer_money_value { sub _append_adj_lines_to { my ($has_more, $line); + $DB::single=1; for ( $_[0] //= do { $has_more = 1; } ) { - if ( s/^"// .. s/(? if $has_more = !$1; + if ( s/^"// .. s/(?; last if $line eq $/; $line =~ s{^\s+}{}; $_ .= $line; @@ -293,34 +273,15 @@ sub _append_adj_lines_to { &_strip_comment_from; } -sub record_credit { - my ($date, $account, $purpose, $amount) = @_; - return $account->credits->create({ - date => $date, - account => $account, - purpose => $purpose, - value => $amount - }); -} - -sub record_debit { - my ($date, $debtor, $billId, $purpose, $value, $targetCredit) = @_; - return $db->resultset("Debit")->create({ - billId => $billId, - date => $date, - debtor => $debtor->ID, - purpose => $purpose, - value => $value, - targetCredit => $targetCredit, - }); -} - sub select_target_credit_from { - my ($account) = @_; + my ($account, $var) = @_; croak "Interactive target credit selection is not possible" if !( -t STDIN ); + print "Please select target credit to reference by $var:\n", + "-------------------------------------------------\n"; + $account = $db->resultset("Account")->find($account); my $credits = $account->credits->search({}, { join => 'income', @@ -339,19 +300,17 @@ sub select_target_credit_from { while (1) { print "Which credit do you want to target? "; chomp( my $input = ); - return $input if $credits->find($input); + return $targets{ $var } = $input if $credits->find($input); warn "Credit ID $input is not a listed option.\n"; } - return; - } sub make_transfers { print "Make transfers ...\n"; if ( ! -t STDIN ) { - die "Input expected from interactive terminal"; + croak "Input expected from interactive terminal"; } my $search_opts = { order_by => { -asc => ['date'] } }; @@ -466,8 +425,61 @@ sub _balance_report { } } +} # End of package Commands + +return 1 if caller; + package main; +use Getopt::Long; + +%OPTS = ( + 'account' => \$ACCOUNT, + 'target-credit' => \%targets +); +GetOptions( \%OPTS, + '1', 'account|a=s', 'target|t=s', 'target-credit|tcr=i', 'source|s=s', + 'date|d=s', 'value|v=i', 'purpose|p=s', 'bill-id|b=s' +); + +my %dispatcher = ( + charge => \&Commands::charge_account, + ct => sub { + Commands::charge_account(); + Commands::make_transfers(); + }, + cts => sub { + Commands::charge_account(); + Commands::make_transfers(); + Commands::balance_status(); + }, + ctr => sub { + Commands::charge_account(); + Commands::make_transfers(); + Commands::balance_status(1); + }, + report => sub { + Commands::balance_status(1); + }, + server => sub { + exec qw{morbo server -w TrsrDB -w templates/}; + }, + sql => sub { + exec "sqlite3" => -cmd => "PRAGMA foreign_keys=ON; PRAGMA recursive_triggers=ON;" + => -line => $ENV{TRSRDB_SQLITE_FILE}; + }, + status => \&Commands::balance_status, + transfer => \&Commands::make_transfers, + tr => sub { + Commands::make_transfers(); + Commands::balance_status(1); + }, + ts => sub { + Commands::make_transfers(); + Commands::balance_status(); + } +); + my $cmd = shift; if ( my $sref = $dispatcher{ $cmd } ) { $sref->();