8bb52473d6025ff5849d5af72f79de4988ecea7e
[chaz/homebank2ledger] / 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
This page took 0.051168 seconds and 3 git commands to generate.