Batch processor (.trsr charge) now also accessible via web interface

Plus, added `./trsr server` and `./trsr sql` calls. These are essentially execs of
morbo and sqlite3 with appropriate arguments.

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');

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") );

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;
 }

templates/account/list.html.ep

@@ -36,7 +36,7 @@
 % } # while
 </table>
 
-% 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
 <h2>Column explanation</h2>
 <dl>

test.sh

@@ -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

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 = (
+sub act_on_other_db {
-    charge => \&Commands::charge_account,
+    $db = shift;
-    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();
-    }
-);
 
-package Commands;
+sub single_charge {
-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 {
     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 Var Amount Purpose     :: Credit (Payment or target)
-    # Date Account +Amount Purpose        :: Payment Credit
+    #              ^^^ Field may be empty, yet not stripped
-    # Date Account -Amount TCr ID Purpose :: Bill
+    # Date Account Amount TCr ID: Purpose :: Bill
-    # Date Account <Amount ID Purpose     :: Outgoing payment
+    #                     ^^^ Field may be empty, yet not stripped
     # Please note: Omit Account if specified on commandline.
 
     my @transfers;
 
     while ( defined( my $line = <ARGV> ) ) {
-        chomp $line;
         _strip_comment_from($line) // next;
-        my ($date, $account, $amount, $purpose) = $ACCOUNT
+        my ($date, $account, $debit, $credit, $purpose) = $ACCOUNT
-            ? do { my @columns = split /[,\s]\s*/, $line, 3;
+            ? do { my @columns = split /[,\s]\s*/, $line, 4;
                    splice @columns, 1, 0, $ACCOUNT;
-                   @columns }
+                   @columns
-            : split /[,\s]\s*/, $line, 4
+                 }
+            : 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);
-            _append_adj_lines_to($purpose);
-            my $r = record_credit($date, $account, $purpose, 0);
-            $targets{ $amount } = $r->credId;
-        }
-        elsif ( $amount =~ s/^([<-])// ) {
 
-            (my ($tgt, $billId), $purpose)
+        if ( $debit =~ /^\d/ ) {
-                = $1 eq q{<} ? (undef, split /\s+/, $purpose, 2)
-                             : (split /\s+/, $purpose, 3)
-                             ;
 
-            _append_adj_lines_to($purpose);
+            my $tgt = $credit;
-
+            my $billId = $purpose =~ s{ \A ([[:print:]]+?) : \s* }{}xms
-            $DB::single=1;
+                       ? $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+)$} ) {
+            if ( my ($var, $op, $assigned)
-                my $op = substr $account, 0, 1;
+                     = $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",
+                    $tgt = select_target_credit_from($assigned, $var);
-                          "-------------------------------------------------\n";
-                    $tgt = $targets{ $var }
-                         = select_target_credit_from($account);
                 }
             }
             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,
+            $account->add_to_debits({
-                integer_money_value($amount), $tgt
+                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;
+        elsif ( $credit =~ /^\d/ ) {
-            _append_adj_lines_to($purpose);
+
-            my $c = record_credit(
+            my $tgt = $purpose =~ s{ \s* >> \s* (.+) \r? \n? \z }{}xms && $1;
-                $date, $account, $purpose, integer_money_value($amount)
+
-            );
+            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; <ARGV> } ) {
-        if ( s/^"// .. s/(?<!")(")(?!")// || $has_more) {
+        if ( s/^"// .. s/(?<!")(")(?=\s|$)// || $has_more) {
-            $line = <ARGV> if $has_more = !$1;
+            last if $1;
+            $line = <ARGV>;
             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 = <STDIN> );
-        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->();