Dogcows Code - chaz/homebank2ledger/blob - lib/App/HomeBank2Ledger/Formatter/Beancount.pm

   1 package App::HomeBank2Ledger::Formatter::Beancount;
   2 # ABSTRACT: Beancount formatter
   3
   4 =head1 DESCRIPTION
   5
   6 This is a formatter for L<Beancount|http://furius.ca/beancount/>.
   7
   8 =head1 SEE ALSO
   9
  10 L<App::HomeBank2Ledger::Formatter>
  11
  12 =cut
  13
  14 use warnings;
  15 use strict;
  16
  17 use App::HomeBank2Ledger::Util qw(commify rtrim);
  18
  19 use parent 'App::HomeBank2Ledger::Formatter';
  20
  21 our $VERSION = '9999.999'; # VERSION
  22
  23 my %STATUS_SYMBOLS = (
  24     cleared => '*',
  25     pending => '!',
  26 );
  27 my $UNKNOWN_DATE = '0001-01-01';
  28
  29 sub _croak { require Carp; Carp::croak(@_) }
  30
  31 sub format {
  32     my $self   = shift;
  33     my $ledger = shift;
  34
  35     my @out = (
  36         $self->format_header,
  37         $self->format_accounts($ledger),
  38         $self->format_commodities($ledger),
  39         # $self->format_payees,
  40         # $self->format_tags,
  41         $self->format_transactions($ledger),
  42     );
  43
  44     return join($/, map { rtrim($_) } @out);
  45 }
  46
  47 =method format_header
  48
  49     @lines = $formatter->format_header;
  50
  51 Get formatted header. For example,
  52
  53     ; Converted from finances.xhb using homebank2ledger 0.001
  54
  55 =cut
  56
  57 sub format_header {
  58     my $self = shift;
  59
  60     my @out;
  61
  62     if (my $name = $self->name) {
  63         push @out, "; Name: $name";
  64     }
  65
  66     my $file = $self->file;
  67     push @out, "; Converted from ${file} using homebank2ledger ${VERSION}";
  68
  69     push @out, '';
  70
  71     return @out;
  72 }
  73
  74 =method format_accounts
  75
  76     @lines = $formatter->format_accounts($ledger);
  77
  78 Get formatted accounts. For example,
  79
  80     2003-02-14 open Assets:Bank:Credit-Union:Savings
  81     2003-02-14 open Assets:Bank:Credit-Union:Checking
  82     ...
  83
  84 =cut
  85
  86 sub format_accounts {
  87     my $self   = shift;
  88     my $ledger = shift;
  89
  90     my @out;
  91
  92     for my $account (sort @{$ledger->accounts}) {
  93         my $oldest_transaction = $self->_find_oldest_transaction_by_account($account, $ledger);
  94         my $account_date = $oldest_transaction->{date} || $UNKNOWN_DATE;
  95         $account = $self->_format_account($account);
  96
  97         push @out, "${account_date} open ${account}";
  98     }
  99     push @out, '';
 100
 101     return @out;
 102 }
 103
 104 =method format_commodities
 105
 106     @lines = $formatter->format_commodities($ledger);
 107
 108 Get formattted commodities. For example,
 109
 110     2003-02-14 commodity USD
 111         name: "US Dollar"
 112     ...
 113
 114 =cut
 115
 116 sub format_commodities {
 117     my $self   = shift;
 118     my $ledger = shift;
 119
 120     my @out;
 121
 122     for my $commodity (@{$ledger->commodities}) {
 123         my $oldest_transaction = $self->_find_oldest_transaction_by_commodity($commodity, $ledger);
 124         my $commodity_date = $oldest_transaction->{date} || $UNKNOWN_DATE;
 125
 126         push @out, "${commodity_date} commodity $commodity->{iso}";
 127         push @out, '    name: '.$self->_format_string($commodity->{name}) if $commodity->{name};
 128     }
 129
 130     push @out, '';
 131
 132     return @out;
 133 }
 134
 135 =method format_transactions
 136
 137     @lines = $formatter->format_transactions($ledger);
 138
 139 Get formatted transactions. For example,
 140
 141     2003-02-14 * "Opening Balance"
 142         Assets:Bank:Credit-Union:Savings           458.21 USD
 143         Assets:Bank:Credit-Union:Checking          194.17 USD
 144         Equity:Opening-Balances
 145
 146     ...
 147
 148 =cut
 149
 150 sub format_transactions {
 151     my $self   = shift;
 152     my $ledger = shift;
 153
 154     my @out;
 155
 156     for my $transaction (@{$ledger->transactions}) {
 157         push @out, $self->_format_transaction($transaction);
 158     }
 159
 160     return @out;
 161 }
 162
 163 sub _format_transaction {
 164     my $self        = shift;
 165     my $transaction = shift;
 166
 167     my $account_width = $self->account_width;
 168
 169     my $date        = $transaction->{date};
 170     my $status      = $transaction->{status};
 171     my $payee       = $transaction->{payee} || '';
 172     my $memo        = $transaction->{memo}  || '';
 173     my @postings    = @{$transaction->{postings}};
 174
 175     my @out;
 176
 177     # figure out the Ledger transaction status
 178     my $status_symbol = $STATUS_SYMBOLS{$status || ''};
 179     if (!$status_symbol) {
 180         my %posting_statuses = map { ($_->{status} || '') => 1 } @postings;
 181         if (keys(%posting_statuses) == 1) {
 182             my ($status) = keys %posting_statuses;
 183             $status_symbol = $STATUS_SYMBOLS{$status || 'none'} || '';
 184         }
 185     }
 186
 187     push @out, sprintf('%s%s%s%s', $date,
 188         $status_symbol    && ' '.$status_symbol || ' *',   # status (or "txn") is required
 189         ($payee || $memo) && ' '.$self->_format_string($payee),
 190         $memo             && ' '.$self->_format_string($memo),
 191     );
 192
 193     if (my %tags = map { $_ => 1 } map { @{$_->{tags} || []} } @postings) {
 194         my @tags = map { "#$_" } keys %tags;
 195         $out[-1] .= ' '.join(' ', @tags);
 196     }
 197
 198     for my $posting (@postings) {
 199         my @line;
 200
 201         my $posting_status_symbol = '';
 202         if (!$status_symbol) {
 203             $posting_status_symbol = $STATUS_SYMBOLS{$posting->{status} || ''} || '';
 204         }
 205
 206         my $account = $self->_format_account($posting->{account});
 207
 208         push @line, ($posting_status_symbol ? "  $posting_status_symbol " : '    ');
 209         push @line, sprintf("\%-${account_width}s", $account);
 210         push @line, '  ';
 211         push @line, $self->_format_amount($posting->{amount}, $posting->{commodity}) if defined $posting->{amount};
 212
 213         push @out, join('', @line);
 214     }
 215
 216     push @out, '';
 217
 218     return @out;
 219 }
 220
 221 sub _format_account {
 222     my $self = shift;
 223     my $account = shift;
 224     $account =~ s/[^A-Za-z0-9:]+/-/g;
 225     $account =~ s/-+/-/g;
 226     $account =~ s/(?:^|(?<=:))([a-z])/uc($1)/eg;
 227     return $account;
 228 }
 229
 230 sub _format_string {
 231     my $self = shift;
 232     my $str  = shift;
 233     $str =~ s/"/\\"/g;
 234     return "\"$str\"";
 235 }
 236
 237 sub _format_amount {
 238     my $self      = shift;
 239     my $amount    = shift;
 240     my $commodity = shift or _croak 'Must provide a valid currency';
 241
 242     my $format = "\% .$commodity->{frac}f";
 243     my ($whole, $fraction) = split(/\./, sprintf($format, $amount));
 244
 245     # beancount doesn't support different notations
 246     my $num = join('.', commify($whole), $fraction);
 247
 248     $num = "$num $commodity->{iso}";
 249
 250     return $num;
 251 }
 252
 253 sub _find_oldest_transaction_by_account {
 254     my $self    = shift;
 255     my $account = shift;
 256     my $ledger  = shift;
 257
 258     $account = $self->_format_account($account);
 259
 260     my $oldest = $self->{oldest_transaction_by_account};
 261     if (!$oldest) {
 262         # build index
 263         for my $transaction (@{$ledger->transactions}) {
 264             for my $posting (@{$transaction->{postings}}) {
 265                 my $account = $self->_format_account($posting->{account});
 266
 267                 if ($transaction->{date} lt ($oldest->{$account}{date} || '9999-99-99')) {
 268                     $oldest->{$account} = $transaction;
 269                 }
 270             }
 271         }
 272
 273         $self->{oldest_transaction_by_account} = $oldest;
 274     }
 275
 276     return $oldest->{$account};
 277 }
 278
 279 sub _find_oldest_transaction_by_commodity {
 280     my $self      = shift;
 281     my $commodity = shift;
 282     my $ledger    = shift;
 283
 284     my $oldest = $self->{oldest_transaction_by_commodity};
 285     if (!$oldest) {
 286         # build index
 287         for my $transaction (@{$ledger->transactions}) {
 288             for my $posting (@{$transaction->{postings}}) {
 289                 my $symbol = $posting->{commodity}{symbol};
 290                 next if !$symbol;
 291
 292                 if ($transaction->{date} lt ($oldest->{$symbol}{date} || '9999-99-99')) {
 293                     $oldest->{$symbol} = $transaction;
 294                 }
 295             }
 296         }
 297
 298         $self->{oldest_transaction_by_commodity} = $oldest;
 299     }
 300
 301     return $oldest->{$commodity->{symbol}};
 302 }
 303
 304 1;