flow/treasuredb
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source 
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.
This commit is contained in:
Florian "flowdy" Heß 2016-07-03 22:05:53 +02:00
parent 57556d252b
commit 3985b46224
10 changed files with 184 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
TrsrDB.pm
View File

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

4
TrsrDB/Account.pm
View File

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

6
TrsrDB/AvailableCredits.pm
View File

@ -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__->set_primary_key("Id");
__PACKAGE__->add_columns(qw/ credId account date purpose difference /);
__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;

2
TrsrDB/Balance.pm
View File

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

4
TrsrDB/Credit.pm
View File

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

4
TrsrDB/CurrentDebts.pm → TrsrDB/CurrentArrears.pm
View File

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

7
TrsrDB/Transfer.pm
View File

@ -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',
{ 'foreign.Id' => 'self.fromCredit' }
credit => 'TrsrDB::Credit', 'credId'
);
__PACKAGE__->belongs_to(

90
schema.sql
View File

@ -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),
UNIQUE (billId, fromCredit)
FOREIGN KEY (credId) REFERENCES Credit(credId),
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
WHERE c.Id = NEW.fromCredit
JOIN Debit d ON c.credId = d.targetCredit
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)
SELECT NEW.Id, m
INSERT INTO Transfer (credId, billId)
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)
SELECT OLD.Id, t.billId
REPLACE INTO Transfer (credId, billId)
SELECT OLD.credId, t.billId
FROM Transfer t
JOIN CurrentDebts cd ON t.billId = cd.billId
WHERE OLD.Id = t.fromCredit
JOIN CurrentArrears ca ON t.billId = ca.billId
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
FROM CurrentDebts
SELECT debtor, sum(difference) AS allArrears
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
JOIN Credit c ON cd.targetCredit = c.Id
FROM CurrentArrears ca
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
GROUP BY c.ID
LEFT OUTER JOIN Debit AS d ON c.credId=d.targetCredit
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
GROUP BY c.ID
LEFT OUTER JOIN Debit AS d ON c.credId=d.targetCredit
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
;

14
t/schema.sql
View File

@ -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);
SELECT ID || ":", credit, '+' || promised, debt * -1 FROM Balance WHERE ID in ("john", "Club");
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, 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);
SELECT ID || ":", credit, '+' || promised, debt * -1 FROM Balance WHERE ID in ("Club", "alex");
INSERT INTO Transfer (billId, credId) VALUES ("TWX2016/123", 1);
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';

19
t/schema.t
View File

@ -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 },
{ john => { ID => 'john', credit => 7200, debt => 7200, promised => 0 },
Club => { ID => 'Club', credit => 0, debt => 23450, promised => 7200 },
alex => { ID => 'alex', credit => 0, debt => 0, promised => 23450 },
is_deeply {
map { $_->ID => {$_->get_columns} }
$db->resultset("Balance")->all
}, {
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();