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

   1 package App::HomeBank2Ledger::Formatter::Ledger;
   2 # ABSTRACT: Ledger formatter
   3
   4 =head1 DESCRIPTION
   5
   6 This is a formatter for L<Ledger|https://www.ledger-cli.org/>.
   7
   8 =head1 SEE ALSO
   9
  10 L<App::HomeBank2Ledger::Formatter>
  11
  12 =cut
  13
  14 use v5.10.1;    # defined-or
  15 use warnings;
  16 use strict;
  17
  18 use App::HomeBank2Ledger::Util qw(commify rtrim);
  19
  20 use parent 'App::HomeBank2Ledger::Formatter';
  21
  22 our $VERSION = '9999.999'; # VERSION
  23
  24 my %STATUS_SYMBOLS = (
  25     cleared => '*',
  26     pending => '!',
  27 );
  28 my $SYMBOL = qr![^\s\d.,;:?\!\-+*/^&|=\<\>\[\]\(\)\{\}\@]+!;
  29
  30 sub _croak { require Carp; Carp::croak(@_) }
  31
  32 sub format {
  33     my $self   = shift;
  34     my $ledger = shift;
  35
  36     my @out = (
  37         $self->format_header,
  38         $self->format_accounts($ledger),
  39         $self->format_commodities($ledger),
  40         $self->format_payees($ledger),
  41         $self->format_tags($ledger),
  42         $self->format_transactions($ledger),
  43     );
  44
  45     return join($/, map { rtrim($_) } @out);
  46 }
  47
  48 =method format_header
  49
  50     @lines = $formatter->format_header;
  51
  52 Get formatted header. For example,
  53
  54     ; Name: My Finances
  55     ; File: path/to/finances.xhb
  56
  57 =cut
  58
  59 sub format_header {
  60     my $self = shift;
  61
  62     my @out;
  63
  64     if (my $name = $self->name) {
  65         push @out, "; Name: $name";
  66     }
  67     if (my $file = $self->file) {
  68         push @out, "; File: $file";
  69     }
  70
  71     push @out, '';
  72
  73     return @out;
  74 }
  75
  76 =method format_accounts
  77
  78     @lines = $formatter->format_accounts($ledger);
  79
  80 Get formatted accounts. For example,
  81
  82     account Assets:Bank:Credit Union:Savings
  83     account Assets:Bank:Credit Union:Checking
  84     ...
  85
  86 =cut
  87
  88 sub format_accounts {
  89     my $self   = shift;
  90     my $ledger = shift;
  91
  92     my @out;
  93
  94     push @out, map { "account $_" } sort @{$ledger->accounts};
  95     push @out, '';
  96
  97     return @out;
  98 }
  99
 100 =method format_commodities
 101
 102     @lines = $formatter->format_commodities($ledger);
 103
 104 Get formattted commodities. For example,
 105
 106     commodity $
 107         note US Dollar
 108         format $  1,000.00
 109         alias USD
 110     ...
 111
 112 =cut
 113
 114 sub format_commodities {
 115     my $self   = shift;
 116     my $ledger = shift;
 117
 118     my @out;
 119
 120     for my $commodity (@{$ledger->commodities}) {
 121         push @out, "commodity $commodity->{symbol}";
 122         push @out, "    note $commodity->{name}"     if $commodity->{name};
 123         push @out, "    format $commodity->{format}" if $commodity->{format};
 124         push @out, "    alias $commodity->{iso}"     if $commodity->{iso};
 125     }
 126
 127     push @out, '';
 128
 129     return @out;
 130 }
 131
 132 =method format_payees
 133
 134     @lines = $formatter->format_payees($ledger);
 135
 136 Get formatted payees. For example,
 137
 138     payee 180 Tacos
 139     ...
 140
 141 =cut
 142
 143 sub format_payees {
 144     my $self   = shift;
 145     my $ledger = shift;
 146
 147     my @out;
 148
 149     push @out, map { "payee $_" } sort @{$ledger->payees};
 150     push @out, '';
 151
 152     return @out;
 153 }
 154
 155 =method format_tags
 156
 157     @lines = $formatter->format_tags($ledger);
 158
 159 Get formatted tags. For example,
 160
 161     tag yapc
 162     ...
 163
 164 =cut
 165
 166 sub format_tags {
 167     my $self   = shift;
 168     my $ledger = shift;
 169
 170     my @out;
 171
 172     push @out, map { "tag $_" } sort @{$ledger->tags};
 173     push @out, '';
 174
 175     return @out;
 176 }
 177
 178 =method format_transactions
 179
 180     @lines = $formatter->format_transactions($ledger);
 181
 182 Get formatted transactions. For example,
 183
 184     2003-02-14 * Opening Balance
 185         Assets:Bank:Credit Union:Savings          $  458.21
 186         Assets:Bank:Credit Union:Checking         $  194.17
 187         Equity:Opening Balances
 188
 189     ...
 190
 191 =cut
 192
 193 sub format_transactions {
 194     my $self   = shift;
 195     my $ledger = shift;
 196
 197     my @out;
 198
 199     for my $transaction (@{$ledger->transactions}) {
 200         push @out, $self->_format_transaction($transaction);
 201     }
 202
 203     return @out;
 204 }
 205
 206 sub _format_transaction {
 207     my $self = shift;
 208     my $transaction = shift;
 209
 210     my $account_width = $self->account_width;
 211
 212     my $date        = $transaction->{date} or _croak 'Transaction date is required';
 213     my $aux_date    = $transaction->{aux_date} || $transaction->{effective_date} || '';
 214     my $status      = $transaction->{status} // '';
 215     my $code        = $transaction->{code};
 216     my $payee       = $self->_format_string($transaction->{payee});
 217     my $note        = $self->_format_string($transaction->{note} // $transaction->{memo});
 218     my @postings    = @{$transaction->{postings} || _croak 'At least one transaction posting is required'};
 219
 220     my @out;
 221
 222     # figure out the Ledger transaction status
 223     my $status_symbol = $STATUS_SYMBOLS{$status};
 224     if (!$status_symbol) {
 225         my %posting_statuses = map { ($_->{status} || '') => 1 } @postings;
 226         if (keys(%posting_statuses) == 1) {
 227             my ($status) = keys %posting_statuses;
 228             $status_symbol = $STATUS_SYMBOLS{$status || 'none'} || '';
 229         }
 230     }
 231
 232     $aux_date = '' if $date eq $aux_date;
 233     $code =~ s/[\(\)]+// if defined $code;
 234     $payee =~ s/(?:  )|\t;/ ;/g if defined $payee;    # don't turn into a note
 235
 236     my $has_code = defined $code && $code ne '';
 237     my $has_payee = defined $payee && $payee ne '';
 238     my $has_note = defined $note && $note ne '';
 239
 240     push @out, join('', $date,
 241         $aux_date               && "=${aux_date}",
 242         $status_symbol          && " ${status_symbol}",
 243         $has_code               && " (${code})",
 244         $has_payee              && " ${payee}",
 245         $has_note && $has_payee && "  ; ${note}",
 246     );
 247     if ($has_note && !$has_payee) {
 248         push @out, "    ; ${note}";
 249     }
 250
 251     my $metadata = $transaction->{metadata} || {};
 252     for my $key (sort keys %$metadata) {
 253         my $value = $self->_format_string($metadata->{$key}) ;
 254         push @out, "    ; ${key}: ${value}";
 255     }
 256
 257     for my $posting (@postings) {
 258         my @line;
 259
 260         my $posting_status_symbol = '';
 261         if (!$status_symbol) {
 262             $posting_status_symbol = $STATUS_SYMBOLS{$posting->{status} || ''} || '';
 263         }
 264
 265         push @line, ($posting_status_symbol ? "  $posting_status_symbol " : '    ');
 266         push @line, sprintf("\%-${account_width}s", $posting->{account});
 267         push @line, '  ';
 268         if (defined $posting->{amount}) {
 269             push @line, $self->_format_amount($posting->{amount}, $posting->{commodity});
 270             my $lot = $posting->{lot} || {};
 271             if (my $lot_price = $lot->{price} // $posting->{lot_price}) {
 272                 my $is_fixed = $lot_price->{fixed} // $posting->{lot_fixed};
 273                 my $fixed_symbol = $is_fixed ? '=' : '';
 274                 push @line, " {${fixed_symbol}",
 275                             $self->_format_amount($lot_price->{amount}, $lot_price->{commodity}),
 276                             '}';
 277             }
 278             if (my $lot_date = $lot->{date} // $posting->{lot_date}) {
 279                 push @line, " [${lot_date}]";
 280             }
 281             if (my $lot_note = $self->_format_string($lot->{note} // $posting->{lot_note} // '')) {
 282                 $lot_note =~ s/[\(\)]+//;   # cleanup
 283                 $lot_note =~ s/^\@+//;
 284                 push @line, " (${lot_note})" if $lot_note;
 285             }
 286             if (my $cost = $posting->{total_cost} // $posting->{cost}) {
 287                 my $is_total = defined $posting->{total_cost};
 288                 my $cost_symbol = $is_total ? '@@' : '@';
 289                 push @line, ' ', $cost_symbol, ' ',
 290                             $self->_format_amount($cost->{amount}, $cost->{commodity});
 291             }
 292         }
 293         my $posting_date        = $posting->{date} || '';
 294         my $posting_aux_date    = $posting->{aux_date} || '';
 295         my $posting_note        = $self->_format_string($posting->{note} // $posting->{memo} // '');
 296         $posting_date       = '' if $posting_date eq $date;
 297         $posting_aux_date   = '' if $posting_aux_date eq $aux_date;
 298         $posting_note       = '' if $has_note && $posting_note eq $note;
 299         my $has_posting_note = defined $posting_note && $posting_note ne '';
 300         if ($posting_date || $posting_aux_date || $has_posting_note) {
 301             if ($posting_date || $posting_aux_date) {
 302                 $posting_note = sprintf('[%s%s]%s',
 303                     $posting_date,
 304                     $posting_aux_date && "=${posting_aux_date}",
 305                     $has_posting_note && " ${posting_note}",
 306                 );
 307             }
 308             push @line, "  ; ${posting_note}";
 309         }
 310
 311         push @out, join('', @line);
 312
 313         my $metadata = $posting->{metadata} || {};
 314         for my $key (sort keys %$metadata) {
 315             my $value = $self->_format_string($metadata->{$key});
 316             push @out, "      ; ${key}: ${value}";
 317         }
 318
 319         if (my $posting_payee = $self->_format_string($posting->{payee} // '')) {
 320             push @out, "      ; Payee: $posting_payee" if !$has_payee || $posting_payee ne $payee;
 321         }
 322
 323         if (my @tags = @{$posting->{tags} || []}) {
 324             push @out, '      ; :'.join(':', @tags).':';
 325         }
 326     }
 327
 328     push @out, '';
 329
 330     return @out;
 331 }
 332
 333 sub _format_string {
 334     my $self = shift;
 335     my $str  = shift // return;
 336     $str =~ s/\v//g;
 337     return $str;
 338 }
 339
 340 sub _quote_string {
 341     my $self = shift;
 342     my $str  = shift;
 343     $str =~ s/"/\\"/g;
 344     return "\"$str\"";
 345 }
 346
 347 sub _format_symbol {
 348     my $self = shift;
 349     my $str  = shift;
 350     return $self->_quote_string($str) if $str !~ /^${SYMBOL}$/;
 351     return $str;
 352 }
 353
 354 sub _format_amount {
 355     my $self      = shift;
 356     my $amount    = shift;
 357     my $commodity = shift or _croak 'Must provide a valid currency';
 358
 359     my $format = "\% .$commodity->{frac}f";
 360     my ($whole, $fraction) = split(/\./, sprintf($format, $amount));
 361     $fraction ||= 0;
 362
 363     my $num = commify($whole, $commodity->{gchar});
 364     if ($commodity->{frac}) {
 365         $num .= $commodity->{dchar} . $fraction;
 366     }
 367
 368     my $symbol = $self->_format_symbol($commodity->{symbol});
 369     $num = $commodity->{syprf} ? "$symbol $num" : "$num $symbol";
 370
 371     return $num;
 372 }
 373
 374 1;