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