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 warnings;
  15 use strict;
  16
  17 use App::HomeBank2Ledger::Util qw(commify);
  18
  19 use parent 'App::HomeBank2Ledger::Formatter';
  20
  21 our $VERSION = '9999.999'; # VERSION
  22
  23 my %STATUS_SYMBOLS = (
  24     cleared => '*',
  25     pending => '!',
  26 );
  27
  28 sub format {
  29     my $self   = shift;
  30     my $ledger = shift;
  31
  32     my @out = (
  33         $self->_format_header,
  34         $self->_format_accounts($ledger),
  35         $self->_format_commodities($ledger),
  36         $self->_format_payees($ledger),
  37         $self->_format_tags($ledger),
  38         $self->_format_transactions($ledger),
  39     );
  40
  41     return join($/, @out);
  42 }
  43
  44 sub _format_header {
  45     my $self = shift;
  46
  47     my @out;
  48
  49     my $file = $self->file;
  50     push @out, "; Converted from $file using homebank2ledger ${VERSION}";
  51
  52     if (my $name = $self->name) {
  53         push @out, "; Name: $name";
  54     }
  55
  56     push @out, '';
  57
  58     return @out;
  59 }
  60
  61 sub _format_accounts {
  62     my $self   = shift;
  63     my $ledger = shift;
  64
  65     my @out;
  66
  67     push @out, map { "account $_" } sort @{$ledger->accounts};
  68     push @out, '';
  69
  70     return @out;
  71 }
  72
  73 sub _format_commodities {
  74     my $self   = shift;
  75     my $ledger = shift;
  76
  77     my @out;
  78
  79     for my $commodity (@{$ledger->commodities}) {
  80         push @out, "commodity $commodity->{symbol}";
  81         push @out, "    note $commodity->{name}"     if $commodity->{name};
  82         push @out, "    format $commodity->{format}" if $commodity->{format};
  83         push @out, "    alias $commodity->{iso}"     if $commodity->{iso};
  84     }
  85
  86     push @out, '';
  87
  88     return @out;
  89 }
  90
  91 sub _format_payees {
  92     my $self   = shift;
  93     my $ledger = shift;
  94
  95     my @out;
  96
  97     push @out, map { "payee $_" } sort @{$ledger->payees};
  98     push @out, '';
  99
 100     return @out;
 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 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       = $transaction->{payee} || 'No Payee TODO';
 137     my $memo        = $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             $status_symbol .= ' ' if $status_symbol;
 150         }
 151     }
 152
 153     my $symbol = $status_symbol ? "${status_symbol} " : '';
 154     push @out, "${date} ${symbol}${payee}  ; $memo";
 155     $out[-1] =~ s/\h+$//;
 156
 157     for my $posting (@postings) {
 158         my @line;
 159
 160         my $posting_status_symbol = '';
 161         if (!$status_symbol) {
 162             $posting_status_symbol = $STATUS_SYMBOLS{$posting->{status} || ''} || '';
 163         }
 164
 165         push @line, ($posting_status_symbol ? "  $posting_status_symbol " : '    ');
 166         push @line, sprintf("\%-${account_width}s", $posting->{account});
 167         push @line, '  ';
 168         push @line, $self->_format_amount($posting->{amount}, $posting->{commodity}) if defined $posting->{amount};
 169
 170         push @out, join('', @line);
 171         $out[-1] =~ s/\h+$//;
 172
 173         if (my $payee = $posting->{payee}) {
 174             push @out, "      ; Payee: $payee";
 175         }
 176
 177         if (my @tags = @{$posting->{tags} || []}) {
 178             push @out, "      ; :".join(':', @tags).":";
 179         }
 180     }
 181
 182     push @out, '';
 183
 184     return @out;
 185 }
 186
 187 sub _format_amount {
 188     my $self      = shift;
 189     my $amount    = shift;
 190     my $commodity = shift;
 191
 192     # _croak 'Must provide a valid currency' if !$commodity;
 193
 194     my $format = "\% .$commodity->{frac}f";
 195     my ($whole, $fraction) = split(/\./, sprintf($format, $amount));
 196
 197     my $num = join($commodity->{dchar}, commify($whole, $commodity->{gchar}), $fraction);
 198
 199     $num = $commodity->{syprf} ? "$commodity->{symbol} $num" : "$num $commodity->{symbol}";
 200
 201     return $num;
 202 }
 203
 204 1;