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     for my $posting (@postings) {
 238         my @line;
 239
 240         my $posting_status_symbol = '';
 241         if (!$status_symbol) {
 242             $posting_status_symbol = $STATUS_SYMBOLS{$posting->{status} || ''} || '';
 243         }
 244
 245         push @line, ($posting_status_symbol ? "  $posting_status_symbol " : '    ');
 246         push @line, sprintf("\%-${account_width}s", $posting->{account});
 247         push @line, '  ';
 248         if (defined $posting->{amount}) {
 249             push @line, $self->_format_amount($posting->{amount}, $posting->{commodity});
 250             if (my $price = $posting->{lot_price}) {
 251                 my $is_fixed = $posting->{lot_fixed};
 252                 my $fixed_symbol = $is_fixed ? '=' : '';
 253                 push @line, " {${fixed_symbol}",
 254                             $self->_format_amount($price->{amount}, $price->{commodity}),
 255                             '}';
 256             }
 257             if (my $lot_date = $posting->{lot_date}) {
 258                 push @line, " [$posting->{lot_date}]";
 259             }
 260             if (my $cost = $posting->{total_cost} // $posting->{cost}) {
 261                 my $is_total = defined $posting->{total_cost};
 262                 my $cost_symbol = $is_total ? '@@' : '@';
 263                 push @line, ' ', $cost_symbol, ' ',
 264                             $self->_format_amount($cost->{amount}, $cost->{commodity});
 265             }
 266         }
 267         if (my $note = $posting->{note}) {
 268             $note = $self->_format_string($note);
 269             push @line, "  ; $note" if $note ne $memo;
 270         }
 271
 272         push @out, join('', @line);
 273
 274         if (my $posting_payee = $posting->{payee}) {
 275             $posting_payee = $self->_format_string($posting_payee);
 276             push @out, "      ; Payee: $posting_payee" if $posting_payee ne $payee;
 277         }
 278
 279         if (my @tags = @{$posting->{tags} || []}) {
 280             push @out, '      ; :'.join(':', @tags).':';
 281         }
 282     }
 283
 284     push @out, '';
 285
 286     return @out;
 287 }
 288
 289 sub _format_string {
 290     my $self = shift;
 291     my $str  = shift;
 292     $str =~ s/\v//g;
 293     return $str;
 294 }
 295
 296 sub _quote_string {
 297     my $self = shift;
 298     my $str  = shift;
 299     $str =~ s/"/\\"/g;
 300     return "\"$str\"";
 301 }
 302
 303 sub _format_amount {
 304     my $self      = shift;
 305     my $amount    = shift;
 306     my $commodity = shift or _croak 'Must provide a valid currency';
 307
 308     my $format = "\% .$commodity->{frac}f";
 309     my ($whole, $fraction) = split(/\./, sprintf($format, $amount));
 310
 311     my $num = join($commodity->{dchar}, commify($whole, $commodity->{gchar}), $fraction);
 312
 313     my $symbol = $commodity->{symbol};
 314     $symbol = $self->_quote_string($symbol) if $symbol =~ /[0-9\s]/;
 315
 316     $num = $commodity->{syprf} ? "$symbol $num" : "$num $symbol";
 317
 318     return $num;
 319 }
 320
 321 1;