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
  29 sub _croak { require Carp; Carp::croak(@_) }
  30
  31 sub format {
  32     my $self   = shift;
  33     my $ledger = shift;
  34
  35     my @out = (
  36         $self->format_header,
  37         $self->format_accounts($ledger),
  38         $self->format_commodities($ledger),
  39         $self->format_payees($ledger),
  40         $self->format_tags($ledger),
  41         $self->format_transactions($ledger),
  42     );
  43
  44     return join($/, map { rtrim($_) } @out);
  45 }
  46
  47 =method format_header
  48
  49     @lines = $formatter->format_header;
  50
  51 Get formatted header. For example,
  52
  53     ; Name: My Finances
  54     ; File: path/to/finances.xhb
  55
  56 =cut
  57
  58 sub format_header {
  59     my $self = shift;
  60
  61     my @out;
  62
  63     if (my $name = $self->name) {
  64         push @out, "; Name: $name";
  65     }
  66     if (my $file = $self->file) {
  67         push @out, "; File: $file";
  68     }
  69
  70     push @out, '';
  71
  72     return @out;
  73 }
  74
  75 =method format_accounts
  76
  77     @lines = $formatter->format_accounts($ledger);
  78
  79 Get formatted accounts. For example,
  80
  81     account Assets:Bank:Credit Union:Savings
  82     account Assets:Bank:Credit Union:Checking
  83     ...
  84
  85 =cut
  86
  87 sub format_accounts {
  88     my $self   = shift;
  89     my $ledger = shift;
  90
  91     my @out;
  92
  93     push @out, map { "account $_" } sort @{$ledger->accounts};
  94     push @out, '';
  95
  96     return @out;
  97 }
  98
  99 =method format_commodities
 100
 101     @lines = $formatter->format_commodities($ledger);
 102
 103 Get formattted commodities. For example,
 104
 105     commodity $
 106         note US Dollar
 107         format $  1,000.00
 108         alias USD
 109     ...
 110
 111 =cut
 112
 113 sub format_commodities {
 114     my $self   = shift;
 115     my $ledger = shift;
 116
 117     my @out;
 118
 119     for my $commodity (@{$ledger->commodities}) {
 120         push @out, "commodity $commodity->{symbol}";
 121         push @out, "    note $commodity->{name}"     if $commodity->{name};
 122         push @out, "    format $commodity->{format}" if $commodity->{format};
 123         push @out, "    alias $commodity->{iso}"     if $commodity->{iso};
 124     }
 125
 126     push @out, '';
 127
 128     return @out;
 129 }
 130
 131 =method format_payees
 132
 133     @lines = $formatter->format_payees($ledger);
 134
 135 Get formatted payees. For example,
 136
 137     payee 180 Tacos
 138     ...
 139
 140 =cut
 141
 142 sub format_payees {
 143     my $self   = shift;
 144     my $ledger = shift;
 145
 146     my @out;
 147
 148     push @out, map { "payee $_" } sort @{$ledger->payees};
 149     push @out, '';
 150
 151     return @out;
 152 }
 153
 154 =method format_tags
 155
 156     @lines = $formatter->format_tags($ledger);
 157
 158 Get formatted tags. For example,
 159
 160     tag yapc
 161     ...
 162
 163 =cut
 164
 165 sub format_tags {
 166     my $self   = shift;
 167     my $ledger = shift;
 168
 169     my @out;
 170
 171     push @out, map { "tag $_" } sort @{$ledger->tags};
 172     push @out, '';
 173
 174     return @out;
 175 }
 176
 177 =method format_transactions
 178
 179     @lines = $formatter->format_transactions($ledger);
 180
 181 Get formatted transactions. For example,
 182
 183     2003-02-14 * Opening Balance
 184         Assets:Bank:Credit Union:Savings          $  458.21
 185         Assets:Bank:Credit Union:Checking         $  194.17
 186         Equity:Opening Balances
 187
 188     ...
 189
 190 =cut
 191
 192 sub format_transactions {
 193     my $self   = shift;
 194     my $ledger = shift;
 195
 196     my @out;
 197
 198     for my $transaction (@{$ledger->transactions}) {
 199         push @out, $self->_format_transaction($transaction);
 200     }
 201
 202     return @out;
 203 }
 204
 205 sub _format_transaction {
 206     my $self = shift;
 207     my $transaction = shift;
 208
 209     my $account_width = $self->account_width;
 210
 211     my $date        = $transaction->{date};
 212     my $status      = $transaction->{status};
 213     my $payee       = $self->_format_string($transaction->{payee} || '');
 214     my $memo        = $self->_format_string($transaction->{memo}  || '');
 215     my @postings    = @{$transaction->{postings}};
 216
 217     my @out;
 218
 219     # figure out the Ledger transaction status
 220     my $status_symbol = $STATUS_SYMBOLS{$status || ''};
 221     if (!$status_symbol) {
 222         my %posting_statuses = map { ($_->{status} || '') => 1 } @postings;
 223         if (keys(%posting_statuses) == 1) {
 224             my ($status) = keys %posting_statuses;
 225             $status_symbol = $STATUS_SYMBOLS{$status || 'none'} || '';
 226         }
 227     }
 228
 229     $payee =~ s/(?:  )|\t;/ ;/g;    # don't turn into a memo
 230
 231     push @out, sprintf('%s%s%s%s', $date,
 232         $status_symbol && " ${status_symbol}",
 233         $payee         && " $payee",
 234         $memo          && "  ; $memo",
 235     );
 236
 237     my $metadata = $transaction->{metadata} || {};
 238     for my $key (sort keys %$metadata) {
 239         my $value = $self->_format_string($metadata->{$key});
 240         push @out, "    ; ${key}: ${value}";
 241     }
 242
 243     for my $posting (@postings) {
 244         my @line;
 245
 246         my $posting_status_symbol = '';
 247         if (!$status_symbol) {
 248             $posting_status_symbol = $STATUS_SYMBOLS{$posting->{status} || ''} || '';
 249         }
 250
 251         push @line, ($posting_status_symbol ? "  $posting_status_symbol " : '    ');
 252         push @line, sprintf("\%-${account_width}s", $posting->{account});
 253         push @line, '  ';
 254         if (defined $posting->{amount}) {
 255             push @line, $self->_format_amount($posting->{amount}, $posting->{commodity});
 256             if (my $price = $posting->{lot_price}) {
 257                 my $is_fixed = $posting->{lot_fixed};
 258                 my $fixed_symbol = $is_fixed ? '=' : '';
 259                 push @line, " {${fixed_symbol}",
 260                             $self->_format_amount($price->{amount}, $price->{commodity}),
 261                             '}';
 262             }
 263             if (my $lot_date = $posting->{lot_date}) {
 264                 push @line, " [$posting->{lot_date}]";
 265             }
 266             if (my $cost = $posting->{total_cost} // $posting->{cost}) {
 267                 my $is_total = defined $posting->{total_cost};
 268                 my $cost_symbol = $is_total ? '@@' : '@';
 269                 push @line, ' ', $cost_symbol, ' ',
 270                             $self->_format_amount($cost->{amount}, $cost->{commodity});
 271             }
 272         }
 273         if (my $note = $posting->{note}) {
 274             $note = $self->_format_string($note);
 275             push @line, "  ; $note" if $note ne $memo;
 276         }
 277
 278         push @out, join('', @line);
 279
 280         my $metadata = $posting->{metadata} || {};
 281         for my $key (sort keys %$metadata) {
 282             my $value = $self->_format_string($metadata->{$key});
 283             push @out, "      ; ${key}: ${value}";
 284         }
 285
 286         if (my $posting_payee = $posting->{payee}) {
 287             $posting_payee = $self->_format_string($posting_payee);
 288             push @out, "      ; Payee: $posting_payee" if $posting_payee ne $payee;
 289         }
 290
 291         if (my @tags = @{$posting->{tags} || []}) {
 292             push @out, '      ; :'.join(':', @tags).':';
 293         }
 294     }
 295
 296     push @out, '';
 297
 298     return @out;
 299 }
 300
 301 sub _format_string {
 302     my $self = shift;
 303     my $str  = shift;
 304     $str =~ s/\v//g;
 305     return $str;
 306 }
 307
 308 sub _quote_string {
 309     my $self = shift;
 310     my $str  = shift;
 311     $str =~ s/"/\\"/g;
 312     return "\"$str\"";
 313 }
 314
 315 sub _format_amount {
 316     my $self      = shift;
 317     my $amount    = shift;
 318     my $commodity = shift or _croak 'Must provide a valid currency';
 319
 320     my $format = "\% .$commodity->{frac}f";
 321     my ($whole, $fraction) = split(/\./, sprintf($format, $amount));
 322
 323     my $num = join($commodity->{dchar}, commify($whole, $commodity->{gchar}), $fraction);
 324
 325     my $symbol = $commodity->{symbol};
 326     $symbol = $self->_quote_string($symbol) if $symbol =~ /[0-9\s]/;
 327
 328     $num = $commodity->{syprf} ? "$symbol $num" : "$num $symbol";
 329
 330     return $num;
 331 }
 332
 333 1;