1 package File
::HomeBank
;
2 # ABSTRACT: Parse HomeBank files
8 use App
::HomeBank2Ledger
::Util
qw(commify);
9 use Exporter
qw(import);
10 use Scalar
::Util
qw(refaddr);
13 use XML
::Parser
::Lite
;
15 our $VERSION = '0.001'; # VERSION
17 our @EXPORT_OK = qw(parse_string parse_file);
41 my %CURRENCY_FLAGS = (
44 my %CATEGORY_FLAGS = (
51 my %TRANSACTION_FLAGS = (
62 my %TRANSACTION_STATUSES = (
69 my %TRANSACTION_PAYMODES = (
75 5 => 'internaltransfer',
84 sub _croak
{ require Carp
; Carp
::croak
(@_) }
85 sub _usage
{ _croak
("Usage: @_\n") }
96 if (my $filepath = $args{file
}) {
97 $self = parse_file
($filepath);
98 $self->{file
} = $filepath;
100 elsif (my $str = $args{string
}) {
101 $self = parse_string
($str);
104 _usage
(q{File::HomeBank->new(string => $str)});
107 return bless $self, $class;
112 my $in_global_destruction = shift;
113 delete $CACHE{refaddr
($self)} if !$in_global_destruction;
123 shift-
>{properties
}{title
};
128 shift-
>{properties
}{currency
};
132 sub accounts
{ shift-
>{accounts
} || [] }
133 sub categories
{ shift-
>{categories
} || [] }
134 sub currencies
{ shift-
>{currencies
} || [] }
135 sub payees
{ shift-
>{payees
} || [] }
136 sub transactions
{ shift-
>{transactions
} || [] }
143 for my $transaction (@{$self->transactions}) {
144 for my $tag (split(/\h+/, $transaction->{tags
} || '')) {
153 sub find_account_by_key
{
155 my $key = shift or return;
157 my $index = $CACHE{refaddr
($self)}{account_by_key
};
160 for my $account (@{$self->accounts}) {
161 $index->{$account->{key
}} = $account;
164 $CACHE{refaddr
($self)}{account_by_key
} = $index;
167 return $index->{$key};
171 sub find_currency_by_key
{
173 my $key = shift or return;
175 my $index = $CACHE{refaddr
($self)}{currency_by_key
};
178 for my $currency (@{$self->currencies}) {
179 $index->{$currency->{key
}} = $currency;
182 $CACHE{refaddr
($self)}{currency_by_key
} = $index;
185 return $index->{$key};
189 sub find_category_by_key
{
191 my $key = shift or return;
193 my $index = $CACHE{refaddr
($self)}{category_by_key
};
196 for my $category (@{$self->categories}) {
197 $index->{$category->{key
}} = $category;
200 $CACHE{refaddr
($self)}{category_by_key
} = $index;
203 return $index->{$key};
207 sub find_payee_by_key
{
209 my $key = shift or return;
211 my $index = $CACHE{refaddr
($self)}{payee_by_key
};
214 for my $payee (@{$self->payees}) {
215 $index->{$payee->{key
}} = $payee;
218 $CACHE{refaddr
($self)}{payee_by_key
} = $index;
221 return $index->{$key};
225 sub find_transactions_by_transfer_key
{
227 my $key = shift or return;
229 my $index = $CACHE{refaddr
($self)}{transactions_by_transfer_key
};
232 for my $transaction (@{$self->transactions}) {
233 my $xfkey = $transaction->{transfer_key
} or next;
234 push @{$index->{$xfkey} ||= []}, $transaction;
237 $CACHE{refaddr
($self)}{transactions_by_transfer_key
} = $index;
240 return @{$index->{$key} || []};
244 sub find_transaction_transfer_pair
{
246 my $transaction = shift;
248 return if $transaction->{paymode
} ne 'internaltransfer';
250 my $transfer_key = $transaction->{transfer_key
};
252 my @matching = grep { refaddr
($_) != refaddr
($transaction) }
253 $self->find_transactions_by_transfer_key($transfer_key);
254 warn "Found more than two transactions with the same transfer key.\n" if 1 < @matching;
255 return $matching[0] if @matching;
257 warn "Found internal transfer with no tranfer key.\n" if !defined $transfer_key;
259 my $dst_account = $self->find_account_by_key($transaction->{dst_account
});
261 warn "Found internal transfer with no destination account.\n";
267 for my $t (@{$self->transactions}) {
268 next if $t->{paymode
} ne 'internaltransfer';
269 next if $t->{account
} != $transaction->{dst_account
};
270 next if $t->{dst_account
} != $transaction->{account
};
271 next if $t->{amount
} != -$transaction->{amount
};
273 my @matching = $self->find_transactions_by_transfer_key($t->{transfer_key
});
274 next if 1 < @matching; # other transaction must also be orphaned
276 push @candidates, $t;
279 my $transaction_day = _ymd_to_julian
($transaction->{date
});
281 # sort the candidates so we can pick the nearest one by date
282 my @ordered_candidates =
284 sort { $a->[0] <=> $b->[0] }
285 map { [abs($transaction_day - _ymd_to_julian
($_->{date
})), $_] } @candidates;
287 if (my $winner = $ordered_candidates[0]) {
288 my $key1 = $transfer_key || '[no key]';
289 my $key2 = $winner->{transfer_key
} || '[no key]';
290 warn "Paired orphaned internal transfer ${key1} and ${key2}.\n";
296 sub sorted_transactions
{
299 my $sorted_transactions = $CACHE{refaddr
($self)}{sorted_transactions
};
300 if (!$sorted_transactions) {
301 $sorted_transactions = [sort { $a->{date
} cmp $b->{date
} } @{$self->transactions}];
303 $CACHE{refaddr
($self)}{sorted_transactions
} = $sorted_transactions;
306 return $sorted_transactions;
310 sub full_category_name
{
312 my $key = shift or return;
314 my $cat = $self->find_category_by_key($key);
316 my @categories = ($cat);
318 while (my $parent_key = $cat->{parent
}) {
319 $cat = $self->find_category_by_key($parent_key);
320 unshift @categories, $cat;
323 return join(':', map { $_->{name
} } @categories);
330 my $currency = shift || $self->base_currency;
332 $currency = $self->find_currency_by_key($currency) if !ref($currency);
333 _croak
'Must provide a valid currency' if !$currency;
335 my $format = "\% .$currency->{frac}f";
336 my ($whole, $fraction) = split(/\./, sprintf($format, $amount));
338 my $num = join($currency->{dchar
}, commify
($whole, $currency->{gchar
}), $fraction);
340 $num = $currency->{syprf
} ? "$currency->{symbol} $num" : "$num $currency->{symbol}";
347 my $filepath = shift or _usage
(q{parse_file($filepath)});
349 open(my $fh, '<', $filepath) or die "open failed: $!";
350 my $str_in = do { local $/; <$fh> };
352 return parse_string
($str_in);
357 my $str = shift or die _usage
(q{parse_string($str)});
366 my $xml_parser = XML
::Parser
::Lite-
>new(
373 # decode all attribute values
374 for my $key (keys %attr) {
375 $attr{$key} = _decode_xml_entities
($attr{$key});
378 if ($node eq 'properties') {
379 $attr{currency
} = delete $attr{curr
} if $attr{curr
};
382 elsif ($node eq 'account') {
383 $attr{type
} = $ACCOUNT_TYPES{$attr{type
} || ''} || 'unknown';
384 $attr{bank_name
} = delete $attr{bankname
} if $attr{bankname
};
385 $attr{currency
} = delete $attr{curr
} if $attr{curr
};
386 $attr{display_position
} = delete $attr{pos} if $attr{pos};
388 my $flags = delete $attr{flags
} || 0;
389 while (my ($shift, $name) = each %ACCOUNT_FLAGS) {
390 $attr{flags
}{$name} = $flags & (1 << $shift) ? 1 : 0;
393 push @accounts, \
%attr;
395 elsif ($node eq 'pay') { # payee
396 push @payees, \
%attr;
398 elsif ($node eq 'cur') { # currency
399 $attr{symbol
} = delete $attr{symb
} if $attr{symb
};
401 my $flags = delete $attr{flags
} || 0;
402 while (my ($shift, $name) = each %CURRENCY_FLAGS) {
403 $attr{flags
}{$name} = $flags & (1 << $shift) ? 1 : 0;
406 push @currencies, \
%attr;
408 elsif ($node eq 'cat') { # category
409 my $flags = delete $attr{flags
} || 0;
410 while (my ($shift, $name) = each %CATEGORY_FLAGS) {
411 $attr{flags
}{$name} = $flags & (1 << $shift) ? 1 : 0;
414 push @categories, \
%attr;
416 elsif ($node eq 'ope') { # transaction
417 $attr{paymode
} = $TRANSACTION_PAYMODES{$attr{paymode
} || ''} || 'unknown';
418 $attr{status
} = $TRANSACTION_STATUSES{delete $attr{st
}} || 'unknown';
420 $attr{transfer_key
} = delete $attr{kxfer
} if $attr{kxfer
};
421 $attr{split_amount
} = delete $attr{samt
} if $attr{samt
};
422 $attr{split_memo
} = delete $attr{smem
} if $attr{smem
};
423 $attr{split_category
} = delete $attr{scat
} if $attr{scat
};
425 $attr{date
} = _rdn_to_ymd
($attr{date
}) if $attr{date
};
427 my $flags = delete $attr{flags
} || 0;
428 while (my ($shift, $name) = each %TRANSACTION_FLAGS) {
429 $attr{flags
}{$name} = $flags & (1 << $shift) ? 1 : 0;
432 push @transactions, \
%attr;
437 $xml_parser->parse($str);
440 properties
=> \
%properties,
441 accounts
=> \
@accounts,
443 categories
=> \
@categories,
444 currencies
=> \
@currencies,
445 transactions
=> \
@transactions,
449 sub _decode_xml_entities
{
451 # decoding entities can be extremely slow, so don't bother if it doesn't look like there are any
453 return $str if $str !~ /&(?:#\d+)|[A-Za-z0-9]+;/;
454 return XML
::Entities
::decode
('all', $str);
457 sub _rdn_to_unix_epoch
{
459 my $jan01_1970 = 719163;
460 return ($rdn - $jan01_1970) * 86400;
465 my $epoch = _rdn_to_unix_epoch
($rdn);
466 my $time = gmtime($epoch);
472 my $t = Time
::Piece-
>strptime($ymd, '%Y-%m-%d');
473 return $t->julian_day;
486 File::HomeBank - Parse HomeBank files
496 use File::HomeBank qw(parse_file);
498 my $raw_data = parse_file('path/to/homebank.xhb');
502 my $homebank = File::HomeBank->new(file => 'path/to/homebank.xhb');
504 for my $account (@{$homebank->accounts}) {
505 print "Found account named $account->{name}\n";
510 This module parses L<HomeBank|http://homebank.free.fr/> files.
516 Get the filepath (if parsed from a file).
522 $homebank = File::HomeBank->new(string => $str);
523 $homebank = File::HomeBank->new(file => $filepath);
525 Construct a L<File::HomeBank>.
529 $title = $homebank->title;
531 Get the title or owner property.
535 $base_currency = $homebank->base_currency;
537 Get the key of the base currency.
541 Get an arrayref of accounts.
545 Get an arrayref of categories.
549 Get an arrayref of currencies.
553 Get an arrayref of payees.
557 Get an arrayref of tags.
561 Get an arrayref of transactions.
563 =head2 find_account_by_key
565 $account = $homebank->find_account_by_key($key);
567 Find a account with the given key.
569 =head2 find_currency_by_key
571 $currency = $homebank->find_currency_by_key($key);
573 Find a currency with the given key.
575 =head2 find_category_by_key
577 $category = $homebank->find_category_by_key($key);
579 Find a category with the given key.
581 =head2 find_payee_by_key
583 $payee = $homebank->find_payee_by_key($key);
585 Find a payee with the given key.
587 =head2 find_transactions_by_transfer_key
589 @transactions = $homebank->find_transactions_by_transfer_key($key);
591 Find all transactions that share the same transfer key.
593 =head2 find_transaction_transfer_pair
595 $other_transaction = $homebank->find_transaction_transfer_pair($transaction);
597 Given a transaction hashref, return its corresponding transaction if it is an internal transfer. If
598 the transaction is an internal transaction with a destination account but is orphaned (has no
599 matching transfer key), this also looks for another orphaned transaction in the destination account
600 that it can call its partner.
602 Returns undef or empty if no corresponding transaction is found.
604 =head2 sorted_transactions
606 $transations = $homebank->sorted_transactions;
608 Get an arrayref of transactions sorted by date (oldest first).
610 =head2 full_category_name
612 $category_name = $homebank->full_category_name($key);
614 Generate the full name for a category, taking category inheritance into consideration.
625 $formatted_amount = $homebank->format_amount($amount);
626 $formatted_amount = $homebank->format_amount($amount, $currency);
628 Formats an amount in either the base currency (for the whole file) or in the given currency.
629 Currency can be a key or the actualy currency structure.
635 $homebank_data = parse_file($filepath);
637 Read and parse a HomeBank .xhb file from a filesystem.
641 $homebank_data = parse_string($str);
643 Parse a HomeBank file from a string.
647 Please report any bugs or feature requests on the bugtracker website
648 L<https://github.com/chazmcgarvey/homebank2ledger/issues>
650 When submitting a bug or request, please include a test-file or a
651 patch to an existing test-file that illustrates the bug or desired
656 Charles McGarvey <chazmcgarvey@brokenzipper.com>
658 =head1 COPYRIGHT AND LICENSE
660 This software is Copyright (c) 2019 by Charles McGarvey.
662 This is free software, licensed under:
664 The MIT (X11) License