b815cd3f0c072407a8d08042610fd7c8ad8196c0
[chaz/homebank2ledger] / 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 sub _format_header {
47 my $self = shift;
48
49 my @out;
50
51 if (my $name = $self->name) {
52 push @out, "; Name: $name";
53 }
54
55 my $file = $self->file;
56 push @out, "; Converted from ${file} using homebank2ledger ${VERSION}";
57
58 push @out, '';
59
60 return @out;
61 }
62
63 sub _format_accounts {
64 my $self = shift;
65 my $ledger = shift;
66
67 my @out;
68
69 push @out, map { "account $_" } sort @{$ledger->accounts};
70 push @out, '';
71
72 return @out;
73 }
74
75 sub _format_commodities {
76 my $self = shift;
77 my $ledger = shift;
78
79 my @out;
80
81 for my $commodity (@{$ledger->commodities}) {
82 push @out, "commodity $commodity->{symbol}";
83 push @out, " note $commodity->{name}" if $commodity->{name};
84 push @out, " format $commodity->{format}" if $commodity->{format};
85 push @out, " alias $commodity->{iso}" if $commodity->{iso};
86 }
87
88 push @out, '';
89
90 return @out;
91 }
92
93 sub _format_payees {
94 my $self = shift;
95 my $ledger = shift;
96
97 my @out;
98
99 push @out, map { "payee $_" } sort @{$ledger->payees};
100 push @out, '';
101
102 return @out;
103 }
104
105 sub _format_tags {
106 my $self = shift;
107 my $ledger = shift;
108
109 my @out;
110
111 push @out, map { "tag $_" } sort @{$ledger->tags};
112 push @out, '';
113
114 return @out;
115 }
116
117 sub _format_transactions {
118 my $self = shift;
119 my $ledger = shift;
120
121 my @out;
122
123 for my $transaction (@{$ledger->transactions}) {
124 push @out, $self->_format_transaction($transaction);
125 }
126
127 return @out;
128 }
129
130 sub _format_transaction {
131 my $self = shift;
132 my $transaction = shift;
133
134 my $account_width = $self->account_width;
135
136 my $date = $transaction->{date};
137 my $status = $transaction->{status};
138 my $payee = $self->_format_string($transaction->{payee} || '');
139 my $memo = $self->_format_string($transaction->{memo} || '');
140 my @postings = @{$transaction->{postings}};
141
142 my @out;
143
144 # figure out the Ledger transaction status
145 my $status_symbol = $STATUS_SYMBOLS{$status || ''};
146 if (!$status_symbol) {
147 my %posting_statuses = map { ($_->{status} || '') => 1 } @postings;
148 if (keys(%posting_statuses) == 1) {
149 my ($status) = keys %posting_statuses;
150 $status_symbol = $STATUS_SYMBOLS{$status || 'none'} || '';
151 }
152 }
153
154 $payee =~ s/(?: )|\t;/ ;/g; # don't turn into a memo
155
156 push @out, sprintf('%s%s%s%s', $date,
157 $status_symbol && " ${status_symbol}",
158 $payee && " $payee",
159 $memo && " ; $memo",
160 );
161
162 for my $posting (@postings) {
163 my @line;
164
165 my $posting_status_symbol = '';
166 if (!$status_symbol) {
167 $posting_status_symbol = $STATUS_SYMBOLS{$posting->{status} || ''} || '';
168 }
169
170 push @line, ($posting_status_symbol ? " $posting_status_symbol " : ' ');
171 push @line, sprintf("\%-${account_width}s", $posting->{account});
172 push @line, ' ';
173 push @line, $self->_format_amount($posting->{amount}, $posting->{commodity}) if defined $posting->{amount};
174
175 push @out, join('', @line);
176
177 if (my $payee = $posting->{payee}) {
178 push @out, ' ; Payee: '.$self->_format_string($payee);
179 }
180
181 if (my @tags = @{$posting->{tags} || []}) {
182 push @out, " ; :".join(':', @tags).":";
183 }
184 }
185
186 push @out, '';
187
188 return @out;
189 }
190
191 sub _format_string {
192 my $self = shift;
193 my $str = shift;
194 $str =~ s/\v//g;
195 return $str;
196 }
197
198 sub _format_amount {
199 my $self = shift;
200 my $amount = shift;
201 my $commodity = shift or _croak 'Must provide a valid currency';
202
203 my $format = "\% .$commodity->{frac}f";
204 my ($whole, $fraction) = split(/\./, sprintf($format, $amount));
205
206 my $num = join($commodity->{dchar}, commify($whole, $commodity->{gchar}), $fraction);
207
208 $num = $commodity->{syprf} ? "$commodity->{symbol} $num" : "$num $commodity->{symbol}";
209
210 return $num;
211 }
212
213 1;
This page took 0.045526 seconds and 3 git commands to generate.