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.007'; # 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};
 135     my $status      = $transaction->{status};
 136     my $payee       = $self->_format_string($transaction->{payee} || '');
 137     my $memo        = $self->_format_string($transaction->{memo}  || '');
 138     my @postings    = @{$transaction->{postings}};
 139
 140     my @out;
 141
 142     # figure out the Ledger transaction status
 143     my $status_symbol = $STATUS_SYMBOLS{$status || ''};
 144     if (!$status_symbol) {
 145         my %posting_statuses = map { ($_->{status} || '') => 1 } @postings;
 146         if (keys(%posting_statuses) == 1) {
 147             my ($status) = keys %posting_statuses;
 148             $status_symbol = $STATUS_SYMBOLS{$status || 'none'} || '';
 149         }
 150     }
 151
 152     $payee =~ s/(?:  )|\t;/ ;/g;    # don't turn into a memo
 153
 154     push @out, sprintf('%s%s%s%s', $date,
 155         $status_symbol && " ${status_symbol}",
 156         $payee         && " $payee",
 157         $memo          && "  ; $memo",
 158     );
 159
 160     my $metadata = $transaction->{metadata} || {};
 161     for my $key (sort keys %$metadata) {
 162         my $value = $self->_format_string($metadata->{$key});
 163         push @out, "    ; ${key}: ${value}";
 164     }
 165
 166     for my $posting (@postings) {
 167         my @line;
 168
 169         my $posting_status_symbol = '';
 170         if (!$status_symbol) {
 171             $posting_status_symbol = $STATUS_SYMBOLS{$posting->{status} || ''} || '';
 172         }
 173
 174         push @line, ($posting_status_symbol ? "  $posting_status_symbol " : '    ');
 175         push @line, sprintf("\%-${account_width}s", $posting->{account});
 176         push @line, '  ';
 177         if (defined $posting->{amount}) {
 178             push @line, $self->_format_amount($posting->{amount}, $posting->{commodity});
 179             if (my $price = $posting->{lot_price}) {
 180                 my $is_fixed = $posting->{lot_fixed};
 181                 my $fixed_symbol = $is_fixed ? '=' : '';
 182                 push @line, " {${fixed_symbol}",
 183                             $self->_format_amount($price->{amount}, $price->{commodity}),
 184                             '}';
 185             }
 186             if (my $lot_date = $posting->{lot_date}) {
 187                 push @line, " [$posting->{lot_date}]";
 188             }
 189             if (my $cost = $posting->{total_cost} // $posting->{cost}) {
 190                 my $is_total = defined $posting->{total_cost};
 191                 my $cost_symbol = $is_total ? '@@' : '@';
 192                 push @line, ' ', $cost_symbol, ' ',
 193                             $self->_format_amount($cost->{amount}, $cost->{commodity});
 194             }
 195         }
 196         if (my $note = $posting->{note}) {
 197             $note = $self->_format_string($note);
 198             push @line, "  ; $note" if $note ne $memo;
 199         }
 200
 201         push @out, join('', @line);
 202
 203         my $metadata = $posting->{metadata} || {};
 204         for my $key (sort keys %$metadata) {
 205             my $value = $self->_format_string($metadata->{$key});
 206             push @out, "      ; ${key}: ${value}";
 207         }
 208
 209         if (my $posting_payee = $posting->{payee}) {
 210             $posting_payee = $self->_format_string($posting_payee);
 211             push @out, "      ; Payee: $posting_payee" if $posting_payee ne $payee;
 212         }
 213
 214         if (my @tags = @{$posting->{tags} || []}) {
 215             push @out, '      ; :'.join(':', @tags).':';
 216         }
 217     }
 218
 219     push @out, '';
 220
 221     return @out;
 222 }
 223
 224 sub _format_string {
 225     my $self = shift;
 226     my $str  = shift;
 227     $str =~ s/\v//g;
 228     return $str;
 229 }
 230
 231 sub _quote_string {
 232     my $self = shift;
 233     my $str  = shift;
 234     $str =~ s/"/\\"/g;
 235     return "\"$str\"";
 236 }
 237
 238 sub _format_amount {
 239     my $self      = shift;
 240     my $amount    = shift;
 241     my $commodity = shift or _croak 'Must provide a valid currency';
 242
 243     my $format = "\% .$commodity->{frac}f";
 244     my ($whole, $fraction) = split(/\./, sprintf($format, $amount));
 245     $fraction ||= 0;
 246
 247     my $num = commify($whole, $commodity->{gchar});
 248     if ($commodity->{frac}) {
 249         $num .= $commodity->{dchar} . $fraction;
 250     }
 251
 252     my $symbol = $commodity->{symbol};
 253     $symbol = $self->_quote_string($symbol) if $symbol =~ /[0-9\s]/;
 254
 255     $num = $commodity->{syprf} ? "$symbol $num" : "$num $symbol";
 256
 257     return $num;
 258 }
 259
 260 1;
 261
 262 __END__
 263
 264 =pod
 265
 266 =encoding UTF-8
 267
 268 =head1 NAME
 269
 270 App::HomeBank2Ledger::Formatter::Ledger - Ledger formatter
 271
 272 =head1 VERSION
 273
 274 version 0.007
 275
 276 =head1 DESCRIPTION
 277
 278 This is a formatter for L<Ledger|https://www.ledger-cli.org/>.
 279
 280 =head1 METHODS
 281
 282 =head2 format_header
 283
 284     @lines = $formatter->format_header;
 285
 286 Get formatted header. For example,
 287
 288     ; Name: My Finances
 289     ; File: path/to/finances.xhb
 290
 291 =head2 format_accounts
 292
 293     @lines = $formatter->format_accounts($ledger);
 294
 295 Get formatted accounts. For example,
 296
 297     account Assets:Bank:Credit Union:Savings
 298     account Assets:Bank:Credit Union:Checking
 299     ...
 300
 301 =head2 format_commodities
 302
 303     @lines = $formatter->format_commodities($ledger);
 304
 305 Get formattted commodities. For example,
 306
 307     commodity $
 308         note US Dollar
 309         format $  1,000.00
 310         alias USD
 311     ...
 312
 313 =head2 format_payees
 314
 315     @lines = $formatter->format_payees($ledger);
 316
 317 Get formatted payees. For example,
 318
 319     payee 180 Tacos
 320     ...
 321
 322 =head2 format_tags
 323
 324     @lines = $formatter->format_tags($ledger);
 325
 326 Get formatted tags. For example,
 327
 328     tag yapc
 329     ...
 330
 331 =head2 format_transactions
 332
 333     @lines = $formatter->format_transactions($ledger);
 334
 335 Get formatted transactions. For example,
 336
 337     2003-02-14 * Opening Balance
 338         Assets:Bank:Credit Union:Savings          $  458.21
 339         Assets:Bank:Credit Union:Checking         $  194.17
 340         Equity:Opening Balances
 341
 342     ...
 343
 344 =head1 SEE ALSO
 345
 346 L<App::HomeBank2Ledger::Formatter>
 347
 348 =head1 BUGS
 349
 350 Please report any bugs or feature requests on the bugtracker website
 351 L<https://github.com/chazmcgarvey/homebank2ledger/issues>
 352
 353 When submitting a bug or request, please include a test-file or a
 354 patch to an existing test-file that illustrates the bug or desired
 355 feature.
 356
 357 =head1 AUTHOR
 358
 359 Charles McGarvey <chazmcgarvey@brokenzipper.com>
 360
 361 =head1 COPYRIGHT AND LICENSE
 362
 363 This software is Copyright (c) 2019 by Charles McGarvey.
 364
 365 This is free software, licensed under:
 366
 367   The MIT (X11) License
 368
 369 =cut