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

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