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.010'; # 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-
>{homebank
}{version
};
128 shift-
>{properties
}{title
};
133 shift-
>{properties
}{currency
};
137 sub accounts
{ shift-
>{accounts
} || [] }
138 sub categories
{ shift-
>{categories
} || [] }
139 sub currencies
{ shift-
>{currencies
} || [] }
140 sub payees
{ shift-
>{payees
} || [] }
141 sub transactions
{ shift-
>{transactions
} || [] }
148 for my $transaction (@{$self->transactions}) {
149 for my $tag (split(/\h+/, $transaction->{tags
} || '')) {
158 sub find_account_by_key
{
160 my $key = shift or return;
162 my $index = $CACHE{refaddr
($self)}{account_by_key
};
165 for my $account (@{$self->accounts}) {
166 $index->{$account->{key
}} = $account;
169 $CACHE{refaddr
($self)}{account_by_key
} = $index;
172 return $index->{$key};
176 sub find_currency_by_key
{
178 my $key = shift or return;
180 my $index = $CACHE{refaddr
($self)}{currency_by_key
};
183 for my $currency (@{$self->currencies}) {
184 $index->{$currency->{key
}} = $currency;
187 $CACHE{refaddr
($self)}{currency_by_key
} = $index;
190 return $index->{$key};
194 sub find_category_by_key
{
196 my $key = shift or return;
198 my $index = $CACHE{refaddr
($self)}{category_by_key
};
201 for my $category (@{$self->categories}) {
202 $index->{$category->{key
}} = $category;
205 $CACHE{refaddr
($self)}{category_by_key
} = $index;
208 return $index->{$key};
212 sub find_payee_by_key
{
214 my $key = shift or return;
216 my $index = $CACHE{refaddr
($self)}{payee_by_key
};
219 for my $payee (@{$self->payees}) {
220 $index->{$payee->{key
}} = $payee;
223 $CACHE{refaddr
($self)}{payee_by_key
} = $index;
226 return $index->{$key};
230 sub find_transactions_by_transfer_key
{
232 my $key = shift or return;
234 my $index = $CACHE{refaddr
($self)}{transactions_by_transfer_key
};
237 for my $transaction (@{$self->transactions}) {
238 my $xfkey = $transaction->{transfer_key
} or next;
239 push @{$index->{$xfkey} ||= []}, $transaction;
242 $CACHE{refaddr
($self)}{transactions_by_transfer_key
} = $index;
245 return @{$index->{$key} || []};
249 sub find_transaction_transfer_pair
{
251 my $transaction = shift;
253 return if !$transaction->{dst_account
};
255 my $transfer_key = $transaction->{transfer_key
};
257 my @matching = grep { refaddr
($_) != refaddr
($transaction) }
258 $self->find_transactions_by_transfer_key($transfer_key);
259 warn "Found more than two transactions with the same transfer key.\n" if 1 < @matching;
260 return $matching[0] if @matching;
262 warn "Found internal transfer with no tranfer key.\n" if !defined $transfer_key;
264 my $dst_account = $self->find_account_by_key($transaction->{dst_account
});
266 warn "Found internal transfer with no destination account.\n";
272 for my $t (@{$self->transactions}) {
273 next if !$t->{dst_account
};
274 next if $t->{account
} != $transaction->{dst_account
};
275 next if $t->{dst_account
} != $transaction->{account
};
276 next if $t->{amount
} != -$transaction->{amount
};
278 my @matching = $self->find_transactions_by_transfer_key($t->{transfer_key
});
279 next if 1 < @matching; # other transaction must also be orphaned
281 push @candidates, $t;
284 my $transaction_day = _ymd_to_julian
($transaction->{date
});
286 # sort the candidates so we can pick the nearest one by date
287 my @ordered_candidates =
289 sort { $a->[0] <=> $b->[0] }
290 map { [abs($transaction_day - _ymd_to_julian
($_->{date
})), $_] } @candidates;
292 if (my $winner = $ordered_candidates[0]) {
293 my $key1 = $transfer_key || '[no key]';
294 my $key2 = $winner->{transfer_key
} || '[no key]';
295 warn "Paired orphaned internal transfer ${key1} and ${key2}.\n";
301 sub sorted_transactions
{
304 my $sorted_transactions = $CACHE{refaddr
($self)}{sorted_transactions
};
305 if (!$sorted_transactions) {
306 $sorted_transactions = [sort { $a->{date
} cmp $b->{date
} } @{$self->transactions}];
308 $CACHE{refaddr
($self)}{sorted_transactions
} = $sorted_transactions;
311 return $sorted_transactions;
315 sub full_category_name
{
317 my $key = shift or return;
319 my $cat = $self->find_category_by_key($key);
321 my @categories = ($cat);
323 while (my $parent_key = $cat->{parent
}) {
324 $cat = $self->find_category_by_key($parent_key);
325 unshift @categories, $cat;
328 return join(':', map { $_->{name
} } @categories);
335 my $currency = shift || $self->base_currency;
337 $currency = $self->find_currency_by_key($currency) if !ref($currency);
338 _croak
'Must provide a valid currency' if !$currency;
340 my $format = "\% .$currency->{frac}f";
341 my ($whole, $fraction) = split(/\./, sprintf($format, $amount));
343 my $num = join($currency->{dchar
}, commify
($whole, $currency->{gchar
}), $fraction);
345 $num = $currency->{syprf
} ? "$currency->{symbol} $num" : "$num $currency->{symbol}";
352 my $filepath = shift or _usage
(q{parse_file($filepath)});
354 open(my $fh, '<', $filepath) or die "open failed: $!";
355 my $str_in = do { local $/; <$fh> };
357 return parse_string
($str_in);
362 my $str = shift or die _usage
(q{parse_string($str)});
372 my $xml_parser = XML
::Parser
::Lite-
>new(
379 # decode all attribute values
380 for my $key (keys %attr) {
381 $attr{$key} = _decode_xml_entities
($attr{$key});
384 if ($node eq 'homebank') {
385 $attr{version
} = delete $attr{v
} if $attr{v
};
388 elsif ($node eq 'properties') {
389 $attr{currency
} = delete $attr{curr
} if $attr{curr
};
392 elsif ($node eq 'account') {
393 $attr{type
} = $ACCOUNT_TYPES{$attr{type
} || ''} || 'unknown';
394 $attr{bank_name
} = delete $attr{bankname
} if $attr{bankname
};
395 $attr{currency
} = delete $attr{curr
} if $attr{curr
};
396 $attr{display_position
} = delete $attr{pos} if $attr{pos};
398 my $flags = delete $attr{flags
} || 0;
399 while (my ($shift, $name) = each %ACCOUNT_FLAGS) {
400 $attr{flags
}{$name} = $flags & (1 << $shift) ? 1 : 0;
403 push @accounts, \
%attr;
405 elsif ($node eq 'pay') { # payee
406 push @payees, \
%attr;
408 elsif ($node eq 'cur') { # currency
409 $attr{symbol
} = delete $attr{symb
} if $attr{symb
};
411 my $flags = delete $attr{flags
} || 0;
412 while (my ($shift, $name) = each %CURRENCY_FLAGS) {
413 $attr{flags
}{$name} = $flags & (1 << $shift) ? 1 : 0;
416 push @currencies, \
%attr;
418 elsif ($node eq 'cat') { # category
419 my $flags = delete $attr{flags
} || 0;
420 while (my ($shift, $name) = each %CATEGORY_FLAGS) {
421 $attr{flags
}{$name} = $flags & (1 << $shift) ? 1 : 0;
424 for my $bnum (0 .. 12) {
425 $attr{budget_amounts
}[$bnum] = delete $attr{"b$bnum"} if $attr{"b$bnum"};
428 push @categories, \
%attr;
430 elsif ($node eq 'ope') { # transaction
431 $attr{paymode
} = $TRANSACTION_PAYMODES{$attr{paymode
} || ''} || 'unknown';
432 $attr{status
} = $TRANSACTION_STATUSES{delete $attr{st
} || ''} || 'unknown';
434 $attr{transfer_key
} = delete $attr{kxfer
} if $attr{kxfer
};
435 $attr{split_amount
} = delete $attr{samt
} if $attr{samt
};
436 $attr{split_memo
} = delete $attr{smem
} if $attr{smem
};
437 $attr{split_category
} = delete $attr{scat
} if $attr{scat
};
439 $attr{date
} = _rdn_to_ymd
($attr{date
}) if $attr{date
};
441 my $flags = delete $attr{flags
} || 0;
442 while (my ($shift, $name) = each %TRANSACTION_FLAGS) {
443 $attr{flags
}{$name} = $flags & (1 << $shift) ? 1 : 0;
446 push @transactions, \
%attr;
451 $xml_parser->parse($str);
454 homebank
=> \
%homebank,
455 properties
=> \
%properties,
456 accounts
=> \
@accounts,
458 categories
=> \
@categories,
459 currencies
=> \
@currencies,
460 transactions
=> \
@transactions,
464 sub _decode_xml_entities
{
466 # decoding entities can be extremely slow, so don't bother if it doesn't look like there are any
468 return $str if $str !~ /&(?:#\d+)|[A-Za-z0-9]+;/;
469 return XML
::Entities
::decode
('all', $str);
472 sub _rdn_to_unix_epoch
{
474 my $jan01_1970 = 719163;
475 return ($rdn - $jan01_1970) * 86400;
480 my $epoch = _rdn_to_unix_epoch
($rdn);
481 my $time = gmtime($epoch);
487 my $t = Time
::Piece-
>strptime($ymd, '%Y-%m-%d');
488 return $t->julian_day;
501 File::HomeBank - Parse HomeBank files
511 use File::HomeBank qw(parse_file);
513 my $raw_data = parse_file('path/to/homebank.xhb');
517 my $homebank = File::HomeBank->new(file => 'path/to/homebank.xhb');
519 for my $account (@{$homebank->accounts}) {
520 print "Found account named $account->{name}\n";
525 This module parses L<HomeBank|http://homebank.free.fr/> files.
531 Get the filepath (if parsed from a file).
537 $homebank = File::HomeBank->new(string => $str);
538 $homebank = File::HomeBank->new(file => $filepath);
540 Construct a L<File::HomeBank>.
544 $version = $homebank->file_version;
546 Get the file format version.
550 $title = $homebank->title;
552 Get the title or owner property.
556 $base_currency = $homebank->base_currency;
558 Get the key of the base currency.
562 Get an arrayref of accounts.
566 Get an arrayref of categories.
570 Get an arrayref of currencies.
574 Get an arrayref of payees.
578 Get an arrayref of tags.
582 Get an arrayref of transactions.
584 =head2 find_account_by_key
586 $account = $homebank->find_account_by_key($key);
588 Find an account with the given key.
590 =head2 find_currency_by_key
592 $currency = $homebank->find_currency_by_key($key);
594 Find a currency with the given key.
596 =head2 find_category_by_key
598 $category = $homebank->find_category_by_key($key);
600 Find a category with the given key.
602 =head2 find_payee_by_key
604 $payee = $homebank->find_payee_by_key($key);
606 Find a payee with the given key.
608 =head2 find_transactions_by_transfer_key
610 @transactions = $homebank->find_transactions_by_transfer_key($key);
612 Find all transactions that share the same transfer key.
614 =head2 find_transaction_transfer_pair
616 $other_transaction = $homebank->find_transaction_transfer_pair($transaction);
618 Given a transaction hashref, return its corresponding transaction if it is an internal transfer. If
619 the transaction is an internal transaction with a destination account but is orphaned (has no
620 matching transfer key), this also looks for another orphaned transaction in the destination account
621 that it can call its partner.
623 Returns undef or empty if no corresponding transaction is found.
625 =head2 sorted_transactions
627 $transations = $homebank->sorted_transactions;
629 Get an arrayref of transactions sorted by date (oldest first).
631 =head2 full_category_name
633 $category_name = $homebank->full_category_name($key);
635 Generate the full name for a category, taking category inheritance into consideration.
646 $formatted_amount = $homebank->format_amount($amount);
647 $formatted_amount = $homebank->format_amount($amount, $currency);
649 Formats an amount in either the base currency (for the whole file) or in the given currency.
650 Currency can be a key or the actualy currency structure.
656 $homebank_data = parse_file($filepath);
658 Read and parse a HomeBank .xhb file from a filesystem.
662 $homebank_data = parse_string($str);
664 Parse a HomeBank file from a string.
668 Please report any bugs or feature requests on the bugtracker website
669 L<https://github.com/chazmcgarvey/homebank2ledger/issues>
671 When submitting a bug or request, please include a test-file or a
672 patch to an existing test-file that illustrates the bug or desired
677 Charles McGarvey <chazmcgarvey@brokenzipper.com>
679 =head1 COPYRIGHT AND LICENSE
681 This software is Copyright (c) 2019 by Charles McGarvey.
683 This is free software, licensed under:
685 The MIT (X11) License