package RevBank::Accounts; use v5.32; use warnings; use experimental 'signatures'; # stable since v5.36 use RevBank::Global; use RevBank::Plugins; use Carp (); use List::Util (); my $filename = "revbank.accounts"; sub _read() { my @accounts; for my $line (slurp $filename) { $line =~ /\S/ or next; # Not using RevBank::Prompt::split_input to keep parsing by external # scripts simple, since so many such scripts exist. my @split = split " ", $line; if ($split[1] =~ /^!/) { # Special case: use rest of the line (see POD). @split = split " ", $line, 2; } push @accounts, \@split; } my %accounts; for (@accounts) { my $name = lc $_->[0]; exists $accounts{$name} and die "$filename: duplicate entry '$name'\n"; $accounts{$name} = $_; if ($name =~ s/^\*//) { # user-accessible special account: support without * prefix exists $accounts{$name} and die "$filename: duplicate entry '$name'\n"; $accounts{$name} = $_; } } return \%accounts; } sub names() { # uniq because *foo causes population of keys '*foo' and 'foo', with # ->[0] both being 'foo'. However, the keys are lowercase, not canonical. return List::Util::uniqstr map $_->[0], values %{ _read() }; } sub balance($account) { return RevBank::Amount->parse_string( _read()->{ lc $account }->[1] ); } sub since($account) { return _read()->{ lc $account }->[3]; } sub create($account) { die "Account already exists" if exists _read()->{ lc $account }; my $now = now(); append $filename, "$account 0.00 $now\n"; RevBank::Plugins::call_hooks("user_created", $account); # until 2027-05-01 RevBank::Plugins::call_hooks("account_created", $account); return $account; } sub update($account, $delta, $transaction_id) { $account = assert_account($account); my $old = RevBank::Amount->new(0); my $new = RevBank::Amount->new(0); rewrite $filename, sub($line) { my @a = split " ", $line; if (lc $a[0] eq lc $account) { $old = RevBank::Amount->parse_string($a[1]); die "Fatal error: invalid balance in revbank:accounts:$.\n" if not defined $old; $new = $old + $delta; my $since = $a[3] // ""; my $newc = $new->cents; my $oldc = $old->cents; $since = "+\@" . now() if $newc > 0 and (!$since or $oldc <= 0); $since = "-\@" . now() if $newc < 0 and (!$since or $oldc >= 0); $since = "0\@" . now() if $newc == 0 and (!$since or $oldc != 0); return sprintf "%-16s %9s %s %s\n", ( $account, $new->string("+"), now(), $since ); } else { return $line; } }; RevBank::Plugins::call_hooks( # Backwards compatibility until 2027-05-01 "user_balance", $account, $old, $delta, $new, $transaction_id ); RevBank::Plugins::call_hooks( "account_balance", $account, $old, $delta, $new, $transaction_id ); } sub is_hidden($account) { return $account =~ /^[-+]/; } sub is_special($account) { return $account =~ /^[-+*]/; } sub parse_user($username, $allow_invalid = 0) { return undef if is_hidden($username); my $accounts = _read(); my $user = $accounts->{ lc $username } or return undef; if ($user->[1] =~ /^!(.*)/) { warn "$username: Invalid account ($1).\n"; } $allow_invalid or defined balance($username) or return undef; return $user->[0]; } sub assert_account($account) { my $accounts = _read(); my $account_info = $accounts->{ lc $account }; if ($account) { Carp::croak("Account $account can't be used") if not defined balance $account; return $account_info->[0]; } return create $account if is_hidden $account; Carp::croak("No such user ($account)"); } # Backwards compatibility until 2027-05-01 *RevBank::Users::names = \&RevBank::Accounts::names; *RevBank::Users::balance = \&RevBank::Accounts::balance; *RevBank::Users::since = \&RevBank::Accounts::since; *RevBank::Users::create = \&RevBank::Accounts::create; *RevBank::Users::update = \&RevBank::Accounts::update; *RevBank::Users::is_hidden = \&RevBank::Accounts::is_hidden; *RevBank::Users::is_special = \&RevBank::Accounts::is_special; *RevBank::Users::parse_user = \&RevBank::Accounts::parse_user; *RevBank::Users::assert_user = \&RevBank::Accounts::assert_account; 1;