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