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