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 warnings;
   6 use strict;
   7
   8 use App::HomeBank2Ledger::Util qw(commify rtrim);
   9
  10 use parent 'App::HomeBank2Ledger::Formatter';
  11
  12 our $VERSION = '0.004'; # VERSION
  13
  14 my %STATUS_SYMBOLS = (
  15     cleared => '*',
  16     pending => '!',
  17 );
  18
  19 sub _croak { require Carp; Carp::croak(@_) }
  20
  21 sub format {
  22     my $self   = shift;
  23     my $ledger = shift;
  24
  25     my @out = (
  26         $self->_format_header,
  27         $self->_format_accounts($ledger),
  28         $self->_format_commodities($ledger),
  29         $self->_format_payees($ledger),
  30         $self->_format_tags($ledger),
  31         $self->_format_transactions($ledger),
  32     );
  33
  34     return join($/, map { rtrim($_) } @out);
  35 }
  36
  37 sub _format_header {
  38     my $self = shift;
  39
  40     my @out;
  41
  42     if (my $name = $self->name) {
  43         push @out, "; Name: $name";
  44     }
  45
  46     my $file = $self->file;
  47     push @out, "; Converted from ${file} using homebank2ledger ${VERSION}";
  48
  49     push @out, '';
  50
  51     return @out;
  52 }
  53
  54 sub _format_accounts {
  55     my $self   = shift;
  56     my $ledger = shift;
  57
  58     my @out;
  59
  60     push @out, map { "account $_" } sort @{$ledger->accounts};
  61     push @out, '';
  62
  63     return @out;
  64 }
  65
  66 sub _format_commodities {
  67     my $self   = shift;
  68     my $ledger = shift;
  69
  70     my @out;
  71
  72     for my $commodity (@{$ledger->commodities}) {
  73         push @out, "commodity $commodity->{symbol}";
  74         push @out, "    note $commodity->{name}"     if $commodity->{name};
  75         push @out, "    format $commodity->{format}" if $commodity->{format};
  76         push @out, "    alias $commodity->{iso}"     if $commodity->{iso};
  77     }
  78
  79     push @out, '';
  80
  81     return @out;
  82 }
  83
  84 sub _format_payees {
  85     my $self   = shift;
  86     my $ledger = shift;
  87
  88     my @out;
  89
  90     push @out, map { "payee $_" } sort @{$ledger->payees};
  91     push @out, '';
  92
  93     return @out;
  94 }
  95
  96 sub _format_tags {
  97     my $self   = shift;
  98     my $ledger = shift;
  99
 100     my @out;
 101
 102     push @out, map { "tag $_" } sort @{$ledger->tags};
 103     push @out, '';
 104
 105     return @out;
 106 }
 107
 108 sub _format_transactions {
 109     my $self   = shift;
 110     my $ledger = shift;
 111
 112     my @out;
 113
 114     for my $transaction (@{$ledger->transactions}) {
 115         push @out, $self->_format_transaction($transaction);
 116     }
 117
 118     return @out;
 119 }
 120
 121 sub _format_transaction {
 122     my $self = shift;
 123     my $transaction = shift;
 124
 125     my $account_width = $self->account_width;
 126
 127     my $date        = $transaction->{date};
 128     my $status      = $transaction->{status};
 129     my $payee       = $self->_format_string($transaction->{payee} || '');
 130     my $memo        = $self->_format_string($transaction->{memo}  || '');
 131     my @postings    = @{$transaction->{postings}};
 132
 133     my @out;
 134
 135     # figure out the Ledger transaction status
 136     my $status_symbol = $STATUS_SYMBOLS{$status || ''};
 137     if (!$status_symbol) {
 138         my %posting_statuses = map { ($_->{status} || '') => 1 } @postings;
 139         if (keys(%posting_statuses) == 1) {
 140             my ($status) = keys %posting_statuses;
 141             $status_symbol = $STATUS_SYMBOLS{$status || 'none'} || '';
 142         }
 143     }
 144
 145     $payee =~ s/(?:  )|\t;/ ;/g;    # don't turn into a memo
 146
 147     push @out, sprintf('%s%s%s%s', $date,
 148         $status_symbol && " ${status_symbol}",
 149         $payee         && " $payee",
 150         $memo          && "  ; $memo",
 151     );
 152
 153     for my $posting (@postings) {
 154         my @line;
 155
 156         my $posting_status_symbol = '';
 157         if (!$status_symbol) {
 158             $posting_status_symbol = $STATUS_SYMBOLS{$posting->{status} || ''} || '';
 159         }
 160
 161         push @line, ($posting_status_symbol ? "  $posting_status_symbol " : '    ');
 162         push @line, sprintf("\%-${account_width}s", $posting->{account});
 163         push @line, '  ';
 164         push @line, $self->_format_amount($posting->{amount}, $posting->{commodity}) if defined $posting->{amount};
 165
 166         push @out, join('', @line);
 167
 168         if (my $payee = $posting->{payee}) {
 169             push @out, '      ; Payee: '.$self->_format_string($payee);
 170         }
 171
 172         if (my @tags = @{$posting->{tags} || []}) {
 173             push @out, "      ; :".join(':', @tags).":";
 174         }
 175     }
 176
 177     push @out, '';
 178
 179     return @out;
 180 }
 181
 182 sub _format_string {
 183     my $self = shift;
 184     my $str  = shift;
 185     $str =~ s/\v//g;
 186     return $str;
 187 }
 188
 189 sub _format_amount {
 190     my $self      = shift;
 191     my $amount    = shift;
 192     my $commodity = shift or _croak 'Must provide a valid currency';
 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;
 205
 206 __END__
 207
 208 =pod
 209
 210 =encoding UTF-8
 211
 212 =head1 NAME
 213
 214 App::HomeBank2Ledger::Formatter::Ledger - Ledger formatter
 215
 216 =head1 VERSION
 217
 218 version 0.004
 219
 220 =head1 DESCRIPTION
 221
 222 This is a formatter for L<Ledger|https://www.ledger-cli.org/>.
 223
 224 =head1 SEE ALSO
 225
 226 L<App::HomeBank2Ledger::Formatter>
 227
 228 =head1 BUGS
 229
 230 Please report any bugs or feature requests on the bugtracker website
 231 L<https://github.com/chazmcgarvey/homebank2ledger/issues>
 232
 233 When submitting a bug or request, please include a test-file or a
 234 patch to an existing test-file that illustrates the bug or desired
 235 feature.
 236
 237 =head1 AUTHOR
 238
 239 Charles McGarvey <chazmcgarvey@brokenzipper.com>
 240
 241 =head1 COPYRIGHT AND LICENSE
 242
 243 This software is Copyright (c) 2019 by Charles McGarvey.
 244
 245 This is free software, licensed under:
 246
 247   The MIT (X11) License
 248
 249 =cut