Added TrsrDB::autobalance(). Renamings and fixes.

Renamed "debts" to "arrears", because of psychologically slightly more positive
connotations. Renamed field "Id" of table Credit to "credId" in analogy to
field "billId" of table Debit.

TrsrDB.pm

@@ -5,7 +5,7 @@ use base qw/DBIx::Class::Schema/;
 use Carp qw/croak/;
 
 __PACKAGE__->load_classes(qw|
-    Account Debit Credit Transfer CurrentDebts AvailableCredits
+    Account Debit Credit Transfer CurrentArrears AvailableCredits
     Balance ReconstructedBankStatement History
 |);
 
@@ -23,4 +23,107 @@ sub import {
     );
 }
 
+sub autobalance {
+    my ($self, @pairs) = @_;
+
+    my $from_to = [
+        undef, AvailableCredits => 'credId',
+        suggested_to_pay => 'billId', undef
+    ];
+    my $to_from = [
+        undef, CurrentArrears => 'billId',
+        payable_with => 'Id', undef
+    ];
+
+    my $transfers = $self->resultset('Transfer');
+    my @dir = ($from_to, $to_from);
+    my ($rs, $transferred_total, $src_total, $tgt_total);
+    
+    while ( my ($src, $tgt) = splice @pairs, 0, 2 ) {
+
+        $rs = $self->resultset("AvailableCredits")->search({
+            credId => [ -or => _expand_ids($src) ]
+        });
+        $src = [ $rs->get_column('credId')->all ];
+        $src_total += $rs->get_column('difference')->sum;
+
+        $rs = $self->resultset("CurrentArrears")->search({
+            billId => [ -or => _expand_ids( $tgt ) ]
+        });
+        $tgt = [ $rs->get_column('billId')->all ];
+        $tgt_total += $rs->get_column('difference')->sum;
+
+        @{$to_from}[5,0] = @{$from_to}[0,5] = ($src, $tgt); 
+        my $i = 0;
+        while ( @$src && @$tgt ) {
+
+            my ($item, $thistable, $thisidname,
+                $m2mrel, $otheridname, $otherids)
+                = @{ $dir[ $i ] }
+                ;
+
+            1 until $item
+                = $self->resultset($thistable)->find(
+                    shift(@$item) // last
+                  );
+
+            my $diff = $item->difference;
+            my @otherids =
+                $item->$m2mrel({
+                    $otheridname => { -in => $otherids }
+                })->get_column($otheridname)->all
+            ;
+            my $transfer;
+            while ( $diff > 0 ) {
+                $transfer = $transfers->create({
+                    $thisidname => $item->id,
+                    $otheridname => shift(@otherids) // last
+                });
+                $transfer->discard_changes; # sorry, DBIx::Class devs, what a bad name!
+                                            # how about 'refresh_from_storage'
+                for ( $transfer->amount ) {
+                     $diff -= $_;
+                     $transferred_total += $_;
+                }
+            }
+            redo if !$diff;
+
+        }
+        continue {
+            $i = !$i || 0;
+        }
+
+    }
+
+    return $src_total, $tgt_total, $transferred_total // 0;
+
+}
+
+sub _expand_ids {
+    my ($ids) = @_;
+    my @ids = map { m{ \A (\d+) - (\d+) \z }xms ? [ $1 .. $2 ] : $_ }
+              ref $ids ? @$ids : split q{,}, $ids
+            ;
+    my (@alternatives, @raws);
+    for my $id ( @ids ) {
+        if ( ref $id eq 'ARRAY' ) {
+            push @raws, @$ids;
+        }
+        elsif ( $id eq '*' ) {
+           @alternatives = ({ -not_in => [] });
+        }
+        elsif (
+            $id =~ s{([%*_?])}{
+                $1 eq '*' ? '%' : $1 eq '?' ? '_' : $1
+            }eg
+        ) {
+           push @alternatives, { -like => $id };
+        }
+        else {
+           push @raws, $id;
+        }
+    }
+    push @alternatives, @raws ? { -in => \@raws } : ();
+    return \@alternatives;
+}
 1;

TrsrDB/Account.pm

@@ -12,11 +12,11 @@ __PACKAGE__->has_many(
     { 'foreign.account' => 'self.ID' }
 );
 __PACKAGE__->has_many(
-    debts => 'TrsrDB::Debit',
+    debits => 'TrsrDB::Debit',
     { 'foreign.debtor' => 'self.ID' }
 );
 __PACKAGE__->has_many(
-    current_debts => 'TrsrDB::CurrentDebts',
+    current_arrears => 'TrsrDB::CurrentArrears',
     { 'foreign.debtor' => 'self.ID' }
 );
 __PACKAGE__->has_many(

TrsrDB/AvailableCredits.pm

@@ -4,8 +4,8 @@ package TrsrDB::AvailableCredits;
 use base qw/DBIx::Class::Core/;
 
 __PACKAGE__->table('AvailableCredits');
-__PACKAGE__->add_columns(qw/ Id account date purpose difference /);
+__PACKAGE__->add_columns(qw/ credId account date purpose difference /);
-__PACKAGE__->set_primary_key("Id");
+__PACKAGE__->set_primary_key("credId");
 
 __PACKAGE__->belongs_to(
     account => 'TrsrDB::Account',
@@ -13,7 +13,7 @@ __PACKAGE__->belongs_to(
 );
 
 __PACKAGE__->many_to_many(
-    suggested_to_pay => account => 'current_debts'
+    suggested_to_pay => account => 'current_arrears'
 );
 
 1;

TrsrDB/Balance.pm

@@ -4,7 +4,7 @@ package TrsrDB::Balance;
 use base qw/DBIx::Class::Core/;
 
 __PACKAGE__->table("Balance");
-__PACKAGE__->add_columns(qw/ID credit promised debt/);
+__PACKAGE__->add_columns(qw/ID credit promised arrears/);
 __PACKAGE__->set_primary_key("ID");
 
 __PACKAGE__->belongs_to(

TrsrDB/Credit.pm

@@ -4,13 +4,13 @@ package TrsrDB::Credit;
 use base qw/DBIx::Class::Core/;
 
 __PACKAGE__->table('Credit');
-__PACKAGE__->add_column("Id" => { data_type => 'INTEGER' });
+__PACKAGE__->add_column("credId" => { data_type => 'INTEGER' });
 __PACKAGE__->add_column("account");
 __PACKAGE__->add_column("date" => { data_type => 'DATE' });
 __PACKAGE__->add_column("purpose");
 __PACKAGE__->add_column("value" => { data_type => 'INTEGER' });
 __PACKAGE__->add_column("spent" => { data_type => 'INTEGER', default => 0 });
-__PACKAGE__->set_primary_key("Id");
+__PACKAGE__->set_primary_key("credId");
 
 __PACKAGE__->belongs_to(
     account => 'TrsrDB::Account',

TrsrDB/CurrentArrears.pm

@@ -1,9 +1,9 @@
 use strict;
 
-package TrsrDB::CurrentDebts;
+package TrsrDB::CurrentArrears;
 use base qw/DBIx::Class::Core/;
 
-__PACKAGE__->table('CurrentDebts');
+__PACKAGE__->table('CurrentArrears');
 __PACKAGE__->add_columns(qw/billId debtor targetCredit date purpose difference/);
 __PACKAGE__->set_primary_key("billId");
 

TrsrDB/Transfer.pm

@@ -6,13 +6,12 @@ use base qw/DBIx::Class::Core/;
 __PACKAGE__->table('Transfer');
 __PACKAGE__->add_column("timestamp" => { data_type => 'TIMESTAMP' });
 __PACKAGE__->add_column("billId");
-__PACKAGE__->add_column("fromCredit");
+__PACKAGE__->add_column("credId" => { data_type => 'INTEGER' });
 __PACKAGE__->add_column("amount" => { data_type => 'INTEGER', nullable => 1 });
-__PACKAGE__->set_primary_key("billId", "fromCredit");
+__PACKAGE__->set_primary_key("billId", "credId");
 
 __PACKAGE__->belongs_to(
-   credit => 'TrsrDB::Credit',
+   credit => 'TrsrDB::Credit', 'credId'
-   { 'foreign.Id' => 'self.fromCredit' }
 );
 
 __PACKAGE__->belongs_to(

schema.sql

@@ -16,10 +16,10 @@ CREATE TABLE Debit (
   value INTEGER NOT NULL, -- Euro-Cent
   paid INTEGER DEFAULT 0, -- Euro-Cent, set and changed automatically (Cache)
   FOREIGN KEY (debtor) REFERENCES Account(ID),
-  FOREIGN KEY (targetCredit) REFERENCES Credit(Id)
+  FOREIGN KEY (targetCredit) REFERENCES Credit(credId)
 );
 CREATE TABLE Credit (
-  Id INTEGER PRIMARY KEY NOT NULL,
+  credId INTEGER PRIMARY KEY NOT NULL,
   account NOT NULL, -- Account des Begünstigten
   date DATE NOT NULL,
   purpose NOT NULL, -- as originally indicated in statement of bank account
@@ -41,11 +41,11 @@ CREATE TABLE Credit (
 CREATE TABLE Transfer (
   timestamp DATE DEFAULT CURRENT_TIMESTAMP,
   billId INTEGER NOT NULL,
-  fromCredit INTEGER NOT NULL, 
+  credId INTEGER NOT NULL, 
   amount INTEGER, -- for later traceability, necessary when revoking transfers
   FOREIGN KEY (billId) REFERENCES Debit(billId),
-  FOREIGN KEY (fromCredit) REFERENCES Credit(Id),
+  FOREIGN KEY (credId) REFERENCES Credit(credId),
-  UNIQUE (billId, fromCredit)
+  UNIQUE (billId, credId)
 );
 
 CREATE TABLE IF NOT EXISTS _temp (d, c, m);
@@ -55,15 +55,15 @@ BEGIN
 
   SELECT RAISE(FAIL, "It is not the debtor who is set to pay")
     WHERE (SELECT debtor FROM Debit WHERE billId=NEW.billId)
-       != (SELECT account FROM Credit WHERE Id=NEW.fromCredit)
+       != (SELECT account FROM Credit WHERE credId=NEW.credId)
     ;
 
   SELECT RAISE(FAIL, "Target of a debit cannot be an incoming payment")
   FROM Credit c
-    JOIN Debit d ON c.Id = d.targetCredit
+    JOIN Debit d ON c.credId = d.targetCredit
-  WHERE c.Id = NEW.fromCredit
+  WHERE c.credId = NEW.credId
     AND c.value > 0
-  GROUP BY c.Id
+  GROUP BY c.credId
     HAVING count(d.billId) == 0
   ;
 
@@ -71,7 +71,7 @@ BEGIN
      SELECT remainingDebt, remainingCredit, min(remainingDebt,remainingCredit) 
      FROM (SELECT
          (SELECT value - paid FROM Debit WHERE billId=NEW.billId) AS remainingDebt, 
-         (SELECT value - spent FROM Credit WHERE Id=NEW.fromCredit) AS remainingCredit
+         (SELECT value - spent FROM Credit WHERE credId=NEW.credId) AS remainingCredit
      )
   ;
 
@@ -86,7 +86,7 @@ BEGIN
 
   UPDATE Credit
       SET value = value + (SELECT m FROM _temp)
-      WHERE Id = (
+      WHERE credId = (
           SELECT targetCredit
           FROM Debit
           WHERE billId=NEW.billId
@@ -99,11 +99,11 @@ BEGIN
         ELSE
           (SELECT m FROM _temp)
       END
-      WHERE Id=NEW.fromCredit;
+      WHERE credId=NEW.credId;
 
   UPDATE Transfer
       SET amount = (SELECT m FROM _temp)
-      WHERE billId=NEW.billId AND fromCredit=NEW.fromCredit
+      WHERE billId=NEW.billId AND credId=NEW.credId
         ;
 
   DELETE FROM _temp;
@@ -123,7 +123,7 @@ BEGIN
 
   UPDATE Credit
       SET value = value - OLD.amount
-      WHERE Id = (
+      WHERE credId = (
           SELECT targetCredit
           FROM Debit
           WHERE billId=OLD.billId
@@ -131,7 +131,7 @@ BEGIN
 
   UPDATE Credit
       SET spent = spent - OLD.amount
-      WHERE Id = OLD.fromCredit;
+      WHERE credId = OLD.credId;
 
   DELETE FROM _temp;
 
@@ -171,40 +171,40 @@ BEGIN
 
     REPLACE INTO _temp (d, m)
     SELECT
-        'from_' || NEW.Id,
+        'from_' || NEW.credId,
         billId 
     FROM Transfer
-    WHERE fromCredit = NEW.Id
+    WHERE credId = NEW.credId
     ORDER BY timestamp DESC
     LIMIT 1
     ;
 
     DELETE
     FROM Transfer
-    WHERE fromCredit = NEW.Id
+    WHERE credId = NEW.credId
       AND billId IN (
         SELECT billId
         FROM _temp
-        WHERE c = 'from_' || NEW.Id
+        WHERE c = 'from_' || NEW.credId
       )
     ;
 
-    INSERT INTO Transfer (fromCredit, billId)
+    INSERT INTO Transfer (credId, billId)
-        SELECT NEW.Id, m
+        SELECT NEW.credId, m
         FROM _temp
-        WHERE d = 'from_' || NEW.Id
+        WHERE d = 'from_' || NEW.credId
           AND NEW.value > (
               SELECT spent
               FROM Credit
-              WHERE Id = NEW.Id
+              WHERE credId = NEW.credId
           )
     ;
 
-    DELETE FROM _temp WHERE d = 'from_' || NEW.Id;
+    DELETE FROM _temp WHERE d = 'from_' || NEW.credId;
 
 END;
 
--- When we enter a transfer, the targetCredit of the associated bill might already be the fromCredit
+-- When we enter a transfer, the targetCredit of the associated bill might already be the credId
 -- of a transfer for other dues itself. We can update (replace) the transfer for an unfullfilled one.
 -- That way, a transfer may issue recursively chained transfers.
 CREATE TRIGGER rebalanceIncreasedCredit
@@ -212,11 +212,11 @@ CREATE TRIGGER rebalanceIncreasedCredit
 WHEN NEW.value > OLD.spent
 BEGIN
 
-    REPLACE INTO Transfer (fromCredit, billId)
+    REPLACE INTO Transfer (credId, billId)
-        SELECT OLD.Id, t.billId
+        SELECT OLD.credId, t.billId
         FROM Transfer t
-          JOIN CurrentDebts cd ON t.billId = cd.billId
+          JOIN CurrentArrears ca ON t.billId = ca.billId
-        WHERE OLD.Id = t.fromCredit
+        WHERE OLD.credId = t.credId
     ;
 
 END;
@@ -239,7 +239,7 @@ END;
 -- when new transfer records are inserted
 CREATE TRIGGER enforceSpentImmutableOutsideTrigger
     BEFORE UPDATE OF spent ON Credit
-    WHEN NOT EXISTS (SELECT * FROM Transfer t WHERE NEW.Id=t.fromCredit AND amount IS NULL)
+    WHEN NOT EXISTS (SELECT * FROM Transfer t WHERE NEW.credId=t.credId AND amount IS NULL)
 BEGIN
     SELECT RAISE(FAIL, "spent is set and adjusted automatically according to added Transfer records")
     WHERE (NEW.spent + IFNULL((SELECT m FROM _temp WHERE c IS NULL AND d IS NULL),0) ) <> OLD.spent;
@@ -249,7 +249,7 @@ CREATE TRIGGER enforceFixedCredit
     BEFORE UPDATE OF value ON Credit
 BEGIN
     SELECT RAISE(FAIL, "Credit involved in transactions to revoke at first")
-    WHERE EXISTS (SELECT * FROM Transfer WHERE fromCredit=NEW.Id);
+    WHERE EXISTS (SELECT * FROM Transfer WHERE credId=NEW.credId);
 END;
 
 CREATE TRIGGER checkIBANatTransfer
@@ -265,7 +265,7 @@ BEGIN
    WHERE fnd IS NULL OR fnd = 0;
 END;
 
-CREATE VIEW CurrentDebts AS
+CREATE VIEW CurrentArrears AS
     SELECT billId,
            debtor,
            targetCredit,
@@ -277,7 +277,7 @@ CREATE VIEW CurrentDebts AS
 ;
       
 CREATE VIEW AvailableCredits AS
-    SELECT account, purpose, date,
+    SELECT credId, account, purpose, date,
            value - spent AS difference
     FROM Credit
     WHERE value != spent
@@ -287,13 +287,13 @@ CREATE VIEW Balance AS
   SELECT Account.ID             AS ID,
       IFNULL(ac.allCredits,0)   AS credit,
       IFNULL(pr.allPromises, 0) AS promised,
-      IFNULL(cd.allDebts, 0)    AS debt
+      IFNULL(ca.allArrears, 0)  AS arrears
   FROM Account
      LEFT OUTER JOIN (
-         SELECT debtor, sum(difference) AS allDebts
+         SELECT debtor, sum(difference) AS allArrears
-         FROM CurrentDebts
+         FROM CurrentArrears
          GROUP BY debtor
-     )                          AS cd ON Account.ID=cd.debtor
+     )                          AS ca ON Account.ID=ca.debtor
      LEFT OUTER JOIN (
          SELECT account, sum(difference) AS allCredits
          FROM AvailableCredits
@@ -301,8 +301,8 @@ CREATE VIEW Balance AS
      )                          AS ac ON Account.ID=ac.account
      LEFT OUTER JOIN (
          SELECT a.ID AS ID, sum(difference) AS allPromises
-         FROM CurrentDebts cd
+         FROM CurrentArrears ca
-             JOIN Credit c ON cd.targetCredit = c.Id
+             JOIN Credit c ON ca.targetCredit = c.credId
              JOIN Account a ON a.ID = c.account
          GROUP BY a.ID
      )                          AS pr ON Account.ID=pr.ID
@@ -315,8 +315,8 @@ CREATE VIEW ReconstructedBankStatement AS
          c.value   AS credit,
          NULL      AS debit
   FROM Credit AS c
-    LEFT OUTER JOIN Debit AS d ON c.ID=d.targetCredit
+    LEFT OUTER JOIN Debit AS d ON c.credId=d.targetCredit
-  GROUP BY c.ID
+  GROUP BY c.credId
     HAVING count(d.billId) == 0 -- exclude internal transfers
   UNION
   SELECT date,
@@ -339,8 +339,8 @@ CREATE VIEW History AS
          NULL            AS contra,    
          NULL            AS billId
   FROM Credit AS c
-    LEFT OUTER JOIN Debit AS d ON c.ID=d.targetCredit
+    LEFT OUTER JOIN Debit AS d ON c.credId=d.targetCredit
-  GROUP BY c.ID
+  GROUP BY c.credId
     HAVING count(d.billId) == 0 -- exclude internal transfers
   UNION -- internal transfers with account as source
   SELECT DATE(timestamp) AS date,
@@ -351,7 +351,7 @@ CREATE VIEW History AS
          c.account       AS contra,
          d.billId        AS billId
   FROM Transfer t
-    LEFT JOIN Credit AS c ON c.Id     = t.fromCredit
+    LEFT JOIN Credit AS c ON c.credId = t.credId
     LEFT JOIN Debit  AS d ON d.billId = t.billId
   UNION -- internal transfers with account as target
   SELECT DATE(timestamp) AS date,
@@ -363,6 +363,6 @@ CREATE VIEW History AS
          d.billId        AS billId
   FROM Transfer t
     LEFT JOIN Debit  AS d ON d.billId = t.billId
-    LEFT JOIN Credit AS c ON c.Id     = t.fromCredit
+    LEFT JOIN Credit AS c ON c.credId = t.credId
   ORDER BY date ASC
 ;

t/schema.sql

@@ -27,15 +27,15 @@ INSERT INTO Debit VALUES ("MB1605-john", "john", 1, "2016-05-01", "Membership fe
 SELECT "ID:	credit	promise debt";
 SELECT "--------------------------------";
 
-SELECT ID || ":", credit, '+' || promised, debt * -1 FROM Balance WHERE ID in ("john", "Club");
+SELECT ID || ":", credit, '+' || promised, arrears * -1 FROM Balance WHERE ID in ("john", "Club");
 
 SELECT "# Reflect john paying its bills all at once ...";
-INSERT INTO Transfer (billId, fromCredit) VALUES ("MB1605-john", 2), ("MB1606-john", 2), ("MB1607-john", 2), ("MB1608-john", 2), ("MB1609-john", 2), ("MB1610-john", 2), ("MB1611-john", 2), ("MB1612-john", 2), ("MB1701-john", 2), ("MB1702-john", 2), ("MB1703-john", 2), ("MB1704-john", 2); 
+INSERT INTO Transfer (billId, credId) VALUES ("MB1605-john", 2), ("MB1606-john", 2), ("MB1607-john", 2), ("MB1608-john", 2), ("MB1609-john", 2), ("MB1610-john", 2), ("MB1611-john", 2), ("MB1612-john", 2), ("MB1701-john", 2), ("MB1702-john", 2), ("MB1703-john", 2), ("MB1704-john", 2); 
-SELECT ID || ":", credit, '+' || promised, debt * -1 FROM Balance WHERE ID in ("john", "Club");
+SELECT ID || ":", credit, '+' || promised, arrears * -1 FROM Balance WHERE ID in ("john", "Club");
 
 SELECT "# Charge Club with server hosting provided by alex ...";
-INSERT INTO Transfer (billId, fromCredit) VALUES ("TWX2016/123", 1);
+INSERT INTO Transfer (billId, credId) VALUES ("TWX2016/123", 1);
-SELECT ID || ":", credit, '+' || promised, debt * -1 FROM Balance WHERE ID in ("Club", "alex");
+SELECT ID || ":", credit, '+' || promised, arrears * -1 FROM Balance WHERE ID in ("Club", "alex");
 
 SELECT "# Some updates and deletes that could, unless denied, destroy consistency ...";
 UPDATE Debit SET paid = 20000 WHERE billId="TWX2016/123";
@@ -47,11 +47,11 @@ BEGIN TRANSACTION;
 DELETE FROM Transfer WHERE billId="TWX2016/123";
 UPDATE Debit SET value = 20000 WHERE billId="TWX2016/123";
 DELETE FROM Debit WHERE billId="TWX2016/123"; -- *SHOULD* work
-SELECT ID || ":", credit, '+' || promised, debt * -1 FROM Balance WHERE ID in ("Club", "alex");
+SELECT ID || ":", credit, '+' || promised, arrears * -1 FROM Balance WHERE ID in ("Club", "alex");
 ROLLBACK TRANSACTION;
 
 SELECT '# But let''s rollback that what-if excurse. This is how it currently is ...';
-SELECT ID || ":", credit, '+' || promised, debt * -1 FROM Balance WHERE ID in ("Club", "alex");
+SELECT ID || ":", credit, '+' || promised, arrears * -1 FROM Balance WHERE ID in ("Club", "alex");
 
 SELECT '###################################################################';
 SELECT '# Now it is your turn: Study the sql code yielding the output above';

t/schema.t

@@ -55,10 +55,10 @@ while ( my ($num, $month) = each %months ) {
     });
 }
 
-is $db->resultset("Account")->find("john")->current_debts->count(), 12,
+is $db->resultset("Account")->find("john")->current_arrears->count(), 12,
    "Entering outstanding member fees for john";
 
-$db->resultset("Account")->find("Club")->add_to_debts({
+$db->resultset("Account")->find("Club")->add_to_debits({
     billId => "TWX2016/123",
     targetCredit => 3,
     date => "2016-01-15",
@@ -68,12 +68,19 @@ $db->resultset("Account")->find("Club")->add_to_debts({
 
 is $db->resultset("Debit")->search({ debtor => 'Club' })->single->billId, "TWX2016/123", "Invoicing server hosting for club";
 
-is_deeply { map { $_->ID => {$_->get_columns} } $db->resultset("Balance")->all },
+is_deeply {
-   { john => { ID => 'john', credit => 7200, debt => 7200,  promised => 0 },
+    map { $_->ID => {$_->get_columns} }
-     Club => { ID => 'Club', credit =>    0, debt => 23450, promised => 7200 },
+    $db->resultset("Balance")->all
-     alex => { ID => 'alex', credit =>    0, debt =>     0, promised => 23450 },
+}, {
+    john => { ID => 'john', credit => 7200, arrears => 7200,  promised => 0 },
+    Club => { ID => 'Club', credit => 0, arrears => 23450, promised => 7200 },
+    alex => { ID => 'alex', credit => 0, arrears => 0, promised => 23450 },
 },
 "Get balances"
 ;    
 
+# Transfer 72 Euro (6 Euro per month) from john's to Club account.
+# Transfer same 72 Euro from Club account to alex hosting the web site.
+is $db->autobalance( (q{*} => q{*}) x 2 ), 14400, 'Automatically balanced credits and debits';
+
 done_testing();