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