From 2752b344bcd543f73fceea80dcdbb11c20dc592a Mon Sep 17 00:00:00 2001 From: Charles McGarvey Date: Wed, 12 Jun 2019 18:42:32 -0600 Subject: [PATCH] initial commit --- .editorconfig | 24 + .gitignore | 14 + Changes | 4 + Makefile | 39 ++ bin/homebank2ledger | 212 ++++++ dist.ini | 15 + lib/App/HomeBank2Ledger.pm | 422 ++++++++++++ lib/App/HomeBank2Ledger/Formatter.pm | 99 +++ .../HomeBank2Ledger/Formatter/Beancount.pm | 194 ++++++ lib/App/HomeBank2Ledger/Formatter/Ledger.pm | 204 ++++++ lib/App/HomeBank2Ledger/Ledger.pm | 178 +++++ lib/App/HomeBank2Ledger/Util.pm | 32 + lib/File/HomeBank.pm | 625 ++++++++++++++++++ 13 files changed, 2062 insertions(+) create mode 100644 .editorconfig create mode 100644 .gitignore create mode 100644 Changes create mode 100644 Makefile create mode 100644 bin/homebank2ledger create mode 100644 dist.ini create mode 100644 lib/App/HomeBank2Ledger.pm create mode 100644 lib/App/HomeBank2Ledger/Formatter.pm create mode 100644 lib/App/HomeBank2Ledger/Formatter/Beancount.pm create mode 100644 lib/App/HomeBank2Ledger/Formatter/Ledger.pm create mode 100644 lib/App/HomeBank2Ledger/Ledger.pm create mode 100644 lib/App/HomeBank2Ledger/Util.pm create mode 100644 lib/File/HomeBank.pm diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..7809e2d --- /dev/null +++ b/.editorconfig @@ -0,0 +1,24 @@ + +# Please follow these code style guidelines. You can use this file to +# automatically configure your editor. +# For instructions, see: http://editorconfig.org/ + +[*] +charset = utf8 +end_of_line = lf +insert_final_newline = true +trim_trailing_whitespace = true + +[{**.pl,**.pm,**.pod,**.t,bin/homebank2ledger}] +indent_style = space +indent_size = 4 +max_line_length = 100 + +[{.editorconfig,**.ini}] +indent_style = space +indent_size = 4 + +[{**.xhb,**.xml}] +indent_style = space +indent_size = 2 + diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c1d1498 --- /dev/null +++ b/.gitignore @@ -0,0 +1,14 @@ +*# +*.bs +*.o +*.tar* +*~ +/.build +/.perl-version +/MYMETA.* +/blib +/cover_db +/homebank2ledger-* +/local* +/pm_to_blib +/tmp diff --git a/Changes b/Changes new file mode 100644 index 0000000..d45db01 --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for homebank2ledger. + +{{$NEXT}} + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..2e456d9 --- /dev/null +++ b/Makefile @@ -0,0 +1,39 @@ + +# This is not a Perl distribution, but it can build one using Dist::Zilla. + +COVER = cover +CPANM = cpanm +DZIL = dzil +PERL = perl +PROVE = prove + +all: dist + +bootstrap: + $(CPANM) $(CPANM_FLAGS) -n Dist::Zilla + $(DZIL) authordeps --missing |$(CPANM) $(CPANM_FLAGS) -n + $(DZIL) listdeps --develop --missing |$(CPANM) $(CPANM_FLAGS) -n + +clean: + $(DZIL) $@ + +cover: + $(COVER) -test + +debug: + $(PERL) -Ilib -d bin/homebank2ledger + +dist: + $(DZIL) build + +distclean: clean + rm -rf cover_db + +run: + $(PERL) -Ilib bin/homebank2ledger + +test: + $(PROVE) -l$(if $(findstring 1,$(V)),v) t + +.PHONY: all bootstrap clean cover debug dist distclean run test + diff --git a/bin/homebank2ledger b/bin/homebank2ledger new file mode 100644 index 0000000..d4a433f --- /dev/null +++ b/bin/homebank2ledger @@ -0,0 +1,212 @@ +#! perl +# ABSTRACT: A tool to convert HomeBank files to Ledger format +# PODNAME: homebank2ledger + +=head1 SYNOPSIS + + homebank2ledger --input FILEPATH [--output FILEPATH] + [--version|--help|--manual] + [--format FORMAT] [--account-width NUM] + [--accounts|--no-accounts] [--payees|--no-payees] + [--tags|--no-tags] [--commodities|--no-commodities] + [--opening-date DATE] [--default-account STR] + [--rename-account STR]... [--exclude-account STR]... + +=head1 DESCRIPTION + +C converts L files to a format usable by +L. It can also convert directly to the similar +L format. + +This software is B. I wrote it because I have been maintaining my own personal +finances using HomeBank (which is awesome) and I wanted to investigate using plain text accounting +programs which have great support for commodities. It works well enough for my data, but you may be +using HomeBank features that I don't so there may be cases this doesn't handle well or at all. Feel +free to file a bug report. This script does NOT try to modify the original HomeBank files it +converts from, so there won't be any crazy data loss bugs... but no warranty. + +=head2 Features + +=for :list +* Converts HomeBank accounts and categories into a typical set of double-entry accounts. +* Retains HomeBank metadata, including payees and tags. +* Offers some customization of the output ledger, like account renaming. + +There aren't really any features I think this program is missing -- actually it may have too many +features -- but if there is anything you think this program could do to be even better, feedback is +welcome; just file a bug report. Or fork the code and have fun! + +=head2 Use cases + +You can migrate the data you have in HomeBank so you can start maintaining your accounts in Ledger +(or Beancount). + +Or if you don't plan to switch completely off of HomeBank, you can continue to maintain your +accounts in HomeBank and use this script to also take advantage of the reports Ledger offers. + +=head1 OPTIONS + +=head2 --version + +Print the version and exit. + +Alias: C<-V> + +=head2 --help + +Print help/usage info and exit. + +Alias: C<-h>, C<-?> + +=head2 --manual + +Print the full manual and exit. + +Alias: C<--man> + +=head2 --input FILEPATH + +Specify the path to the HomeBank file to read (must already exist). + +Alias: C<--file>, C<-i> + +=head2 --output FILEPATH + +Specify the path to the Ledger file to write (may not exist yet). If not provided, the formatted +ledger will be printed on C. + +Alias: C<-o> + +=head2 --format STR + +Specify the output file format. If provided, must be one of: + +=for :list +* ledger +* beancount + +=head2 --account-width NUM + +Specify the number of characters to reserve for the account column in transactions. Adjusting this +can provide prettier formatting of the output. + +Defaults to 40. + +=head2 --accounts + +Enables account declarations. + +Defaults to enabled; use C<--no-accounts> to disable. + +=head2 --payees + +Enables payee declarations. + +Defaults to enabled; use C<--no-payees> to disable. + +=head2 --tags + +Enables tag declarations. + +Defaults to enabled; use C<--no-tags> to disable. + +=head2 --commodities + +Enables commodity declarations. + +Defaults to enabled; use C<--no-commodities> to disable. + +=head2 --opening-date DATE + +Specify the opening date for the "opening balances" transaction. This transaction is created (if +needed) to support HomeBank's ability to configure accounts with opening balances. + +Date must be in the form "YYYY-MM-DD". Defaults to the date of the first transaction. + +=head2 --default-account STR + +Specify the account to use for one-sided transactions (if any). Defaults to "Expenses:No Category". + +A default account may be necessary because with Ledger all transactions are double-entry. + +=head2 --rename-account STR + +Specifies a mapping for renaming accounts in the output. By default C tries to come +up with sensible account names (based on your HomeBank accounts and categories) that fit into five +root accounts: + +=for :list +* Assets +* Liabilities +* Equity +* Income +* Expenses + +The value of the argument must be of the form "REGEXP=REPLACEMENT". See L. + +Can be repeated to rename multiple accounts. + +=head2 --exclude-account STR + +Specifies an account that will not be included in the output. All transactions related to this +account will be skipped. + +Can be repeated to exclude multiple accounts. + +=head1 EXAMPLES + +=head2 Basic usage + + # Convert homebank.xhb to a Ledger-compatible file: + homebank2ledger path/to/homebank.xhb -o ledger.dat + + # Run the Ledger balance report: + ledger -f ledger.dat balance + +You can also combine this into one command: + + homebank2ledger path/to/homebank.xhb | ledger -f - balance + +=head2 Account renaming + +With the L argument, you have some control over the resulting account +structure. This may be useful in cases where the organization imposed (or encouraged) by HomeBank +doesn't necessarily line up with an ideal double-entry structure. + + homebank2ledger path/to/homebank.xhb -o ledger.dat \ + --rename-account '^Assets:Credit Union Savings$=Assets:Bank:Credit Union:Savings' \ + --rename-account '^Assets:Credit Union Checking$=Assets:Bank:Credit Union:Checking' + +Multiple accounts can be renamed at the same time because the first part of the mapping is a regular +expression. The above example could be written like this: + + homebank2ledger path/to/homebank.xhb -o ledger.dat \ + --rename-account '^Assets:Credit Union =Assets:Bank:Credit Union:' + +You can also merge accounts by simple renaming multiple accounts to the same name: + + homebank2ledger path/to/homebank.xhb -o ledger.dat \ + --rename-account '^Liabilities:Chase VISA$=Liabilities:All Credit Cards' \ + --rename-account '^Liabilities:Amex$=Liabilities:All Credit Cards' + +If you need to do anything more complicated, of course you can edit the output after converting; +it's just plain text. + +=head2 Beancount + + # Convert homebank.xhb to a Beancount-compatible file: + homebank2ledger path/to/homebank.xhb -f beancount -o ledger.beancount + + # Run the balances report: + bean-report ledger.beancount balances + +=cut + +use warnings; +use strict; + +use App::HomeBank2Ledger; + +our $VERSION = '9999.999'; # VERSION + +App::HomeBank2Ledger->main(@ARGV); diff --git a/dist.ini b/dist.ini new file mode 100644 index 0000000..5e951ae --- /dev/null +++ b/dist.ini @@ -0,0 +1,15 @@ + +name = homebank2ledger +main_module = lib/App/HomeBank2Ledger.pm +author = Charles McGarvey +copyright_holder = Charles McGarvey +copyright_year = 2019 +license = MIT + +[@Filter] +-bundle = @Author::CCM +-remove = Test::CleanNamespaces +max_target_perl = 5.14 + +[ConsistentVersionTest] + diff --git a/lib/App/HomeBank2Ledger.pm b/lib/App/HomeBank2Ledger.pm new file mode 100644 index 0000000..52f4267 --- /dev/null +++ b/lib/App/HomeBank2Ledger.pm @@ -0,0 +1,422 @@ +package App::HomeBank2Ledger; +# ABSTRACT: A tool to convert HomeBank files to Ledger format + +=head1 SYNOPSIS + + App::HomeBank2Ledger->main(@args); + +=head1 DESCRIPTION + +This module is part of the L script. + +=cut + +# TODO - add posting memo +# TODO - transaction description ("narration" in beancount) +# TODO - payees +# TODO - budget/scheduled +# TODO - consolidate tags on transaction +# TODO - consolidate payees on transaction + +use warnings FATAL => 'all'; # temp fatal all +use strict; + +use App::HomeBank2Ledger::Formatter; +use App::HomeBank2Ledger::Ledger; +use File::HomeBank; +use Getopt::Long 2.38 qw(GetOptionsFromArray); +use Pod::Usage; + +our $VERSION = '9999.999'; # VERSION + +my %ACCOUNT_TYPES = ( # map HomeBank account types to Ledger accounts + bank => 'Assets:Bank', + cash => 'Assets:Cash', + asset => 'Assets:Fixed Assets', + creditcard => 'Liabilities:Credit Card', + liability => 'Liabilities', + stock => 'Assets:Stock', + mutualfund => 'Assets:Mutual Fund', + income => 'Income', + expense => 'Expenses', + equity => 'Equity', +); +my %STATUS_SYMBOLS = ( + cleared => 'cleared', + reconciled => 'cleared', + remind => 'pending', +); +my $UNKNOWN_ACCOUNT = 'Assets:Unknown'; +my $OPENING_BALANCES_ACCOUNT = 'Equity:Opening Balances'; + +=method main + + App::HomeBank2Ledger->main(@args); + +Run the script and exit; does not return. + +=cut + +sub main { + my $class = shift; + my $self = bless {}, $class; + + my $opts = $self->parse_args(@_); + + if ($opts->{version}) { + print "homebank2ledger ${VERSION}\n"; + exit 0; + } + if ($opts->{help}) { + pod2usage(-exitval => 0, -verbose => 99, -sections => [qw(NAME SYNOPSIS OPTIONS)]); + } + if ($opts->{manual}) { + pod2usage(-exitval => 0, -verbose => 2); + } + + my $homebank = File::HomeBank->new(file => $opts->{input}); + + my $formatter = eval { $self->formatter($homebank, $opts) }; + if (my $err = $@) { + if ($err =~ /^Invalid formatter/) { + print STDERR "Invalid format: $opts->{format}\n"; + exit 2; + } + die $err; + } + + my $ledger = $self->convert_homebank_to_ledger($homebank, $opts); + + $self->print_to_file($formatter->format($ledger), $opts->{output}); + + exit 0; +} + +=method formatter + + $formatter = $app->formatter($homebank, $opts); + +Generate a L. + +=cut + +sub formatter { + my $self = shift; + my $homebank = shift; + my $opts = shift || {}; + + return App::HomeBank2Ledger::Formatter->new( + type => $opts->{format}, + account_width => $opts->{account_width}, + name => $homebank->title, + file => $homebank->file, + ); +} + +=method convert_homebank_to_ledger + + my $ledger = $app->convert_homebank_to_ledger($homebank, $opts); + +Converts a L to a L. + +=cut + +sub convert_homebank_to_ledger { + my $self = shift; + my $homebank = shift; + my $opts = shift || {}; + + my $ledger = App::HomeBank2Ledger::Ledger->new; + + my $transactions = $homebank->sorted_transactions; + my $accounts = $homebank->accounts; + my $categories = $homebank->categories; + + # determine full Ledger account names + for my $account (@$accounts) { + my $type = $ACCOUNT_TYPES{$account->{type}} || $UNKNOWN_ACCOUNT; + $account->{ledger_name} = "${type}:$account->{name}"; + } + for my $category (@$categories) { + my $type = $category->{flags}{income} ? 'Income' : 'Expenses'; + my $full_name = $homebank->full_category_name($category->{key}); + $category->{ledger_name} = "${type}:${full_name}"; + } + + # handle renaming and marking excluded accounts + for my $item (@$accounts, @$categories) { + while (my ($re, $replacement) = each %{$opts->{rename_accounts}}) { + $item->{ledger_name} =~ s/$re/$replacement/; + } + for my $re (@{$opts->{exclude_accounts}}) { + $item->{excluded} = 1 if $item->{ledger_name} =~ /$re/; + } + } + + my $has_initial_balance = grep { $_->{initial} && !$_->{excluded} } @$accounts; + + if ($opts->{accounts}) { + my @accounts = map { $_->{ledger_name} } grep { !$_->{excluded} } @$accounts, @$categories; + + push @accounts, $opts->{default_account}; + push @accounts, $OPENING_BALANCES_ACCOUNT if $has_initial_balance; + + $ledger->add_accounts(@accounts); + } + + if ($opts->{payees}) { + my $payees = $homebank->payees; + my @payees = map { $_->{name} } @$payees; + + $ledger->add_payees(@payees); + } + + if ($opts->{tags}) { + my $tags = $homebank->tags; + + $ledger->add_tags(@$tags); + } + + my %commodities; + + for my $currency (@{$homebank->currencies}) { + my $commodity = { + symbol => $currency->{symbol}, + format => $homebank->format_amount(1_000, $currency), + iso => $currency->{iso}, + name => $currency->{name}, + }; + $commodities{$currency->{key}} = { + %$commodity, + syprf => $currency->{syprf}, + dchar => $currency->{dchar}, + gchar => $currency->{gchar}, + frac => $currency->{frac}, + }; + + $ledger->add_commodities($commodity) if $opts->{commodities}; + } + + if ($has_initial_balance) { + # transactions are sorted, so the first transaction is the earliest + my $first_date = $opts->{opening_date} || $transactions->[0]{date}; + if ($first_date !~ /^\d{4}-\d{2}-\d{2}$/) { + die "Opening date must be in the form YYYY-MM-DD.\n"; + } + + my @postings; + + for my $account (@$accounts) { + next if !$account->{initial} || $account->{excluded}; + + push @postings, { + account => $account->{ledger_name}, + amount => $account->{initial}, + commodity => $commodities{$account->{currency}}, + }; + } + + push @postings, { + account => $OPENING_BALANCES_ACCOUNT, + }; + + $ledger->add_transactions({ + date => $first_date, + payee => 'Opening Balance', + status => 'cleared', + postings => \@postings, + }); + } + + my %seen; + + TRANSACTION: + for my $transaction (@$transactions) { + next if $seen{$transaction->{transfer_key} || ''}; + + my $account = $homebank->find_account_by_key($transaction->{account}); + my $amount = $transaction->{amount}; + my $status = $STATUS_SYMBOLS{$transaction->{status} || ''} || ''; + my $paymode = $transaction->{paymode} || ''; # internaltransfer + my $memo = $transaction->{wording} || ''; + my $payee = $homebank->find_payee_by_key($transaction->{payee}); + my $tags = _split_tags($transaction->{tags}); + + my @postings; + + push @postings, { + account => $account->{ledger_name}, + amount => $amount, + commodity => $commodities{$account->{currency}}, + payee => $payee->{name}, + memo => $memo, + status => $status, + tags => $tags, + }; + + if ($paymode eq 'internaltransfer') { + my $paired_transaction = $homebank->find_transaction_transfer_pair($transaction); + + my $dst_account = $homebank->find_account_by_key($transaction->{dst_account}); + if (!$dst_account) { + if ($paired_transaction) { + $dst_account = $homebank->find_account_by_key($paired_transaction->{account}); + } + if (!$dst_account) { + warn "Skipping internal transfer transaction with no destination account.\n"; + next TRANSACTION; + } + } + + $seen{$transaction->{transfer_key}}++ if $transaction->{transfer_key}; + $seen{$paired_transaction->{transfer_key}}++ if $paired_transaction->{transfer_key}; + + my $paired_payee = $homebank->find_payee_by_key($paired_transaction->{payee}); + + push @postings, { + account => $dst_account->{ledger_name}, + amount => $paired_transaction->{amount} || -$transaction->{amount}, + commodity => $commodities{$dst_account->{currency}}, + payee => $paired_payee->{name}, + memo => $paired_transaction->{wording} || '', + status => $STATUS_SYMBOLS{$paired_transaction->{status} || ''} || $status, + tags => _split_tags($paired_transaction->{tags}), + }; + } + elsif ($transaction->{flags}{split}) { + my @amounts = split(/\|\|/, $transaction->{split_amount} || ''); + my @memos = split(/\|\|/, $transaction->{split_memo} || ''); + my @categories = split(/\|\|/, $transaction->{split_category} || ''); + + for (my $i = 0; $amounts[$i]; ++$i) { + my $amount = -$amounts[$i]; + my $category = $homebank->find_category_by_key($categories[$i]); + my $memo = $memos[$i] || ''; + my $other_account = $category ? $category->{ledger_name} : $opts->{default_account}; + + push @postings, { + account => $other_account, + commodity => $commodities{$account->{currency}}, + amount => $amount, + payee => $payee->{name}, + memo => $memo, + status => $status, + tags => $tags, + }; + } + } + else { # with or without category + my $category = $homebank->find_category_by_key($transaction->{category}); + my $other_account = $category ? $category->{ledger_name} : $opts->{default_account}; + push @postings, { + account => $other_account, + commodity => $commodities{$account->{currency}}, + amount => -$transaction->{amount}, + payee => $payee->{name}, + memo => '', # TODO + status => $status, + tags => $tags, + }; + } + + # skip excluded accounts + for my $posting (@postings) { + for my $re (@{$opts->{exclude_accounts}}) { + next TRANSACTION if $posting->{account} =~ /$re/; + } + } + + $ledger->add_transactions({ + date => $transaction->{date}, + payee => 'Payee TODO', + postings => \@postings, + }); + } + + return $ledger; +} + +=method print_to_file + + $app->print_to_file($str); + $app->print_to_file($str, $filepath); + +Print a string to a file (or STDOUT). + +=cut + +sub print_to_file { + my $self = shift; + my $str = shift; + my $filepath = shift; + + my $out_fh = \*STDOUT; + if ($filepath) { + open($out_fh, '>', $filepath) or die "open failed: $!"; + } + print $out_fh $str; +} + +=method parse_args + + $opts = $app->parse_args(@args); + +Parse command-line arguments. + +=cut + +sub parse_args { + my $self = shift; + my @args = @_; + + my %opts = ( + version => 0, + help => 0, + manual => 0, + input => undef, + output => undef, + format => 'ledger', + account_width => 40, + accounts => 1, + payees => 1, + tags => 1, + commodities => 1, + opening_date => '', + default_account => 'Expenses:No Category', + rename_accounts => {}, + exclude_accounts => [], + ); + + GetOptionsFromArray(\@args, + 'version|V' => \$opts{version}, + 'help|h|?' => \$opts{help}, + 'manual|man' => \$opts{manual}, + 'input|file|i=s' => \$opts{input}, + 'output|o=s' => \$opts{output}, + 'format|f=s' => \$opts{format}, + 'account-width=i' => \$opts{account_width}, + 'accounts!' => \$opts{accounts}, + 'payees!' => \$opts{payees}, + 'tags!' => \$opts{tags}, + 'commodities!' => \$opts{commodities}, + 'opening-date=s' => \$opts{opening_date}, + 'default-account=s' => \$opts{default_account}, + 'rename-account|r=s' => \%{$opts{rename_accounts}}, + 'exclude-account|x=s' => \@{$opts{exclude_accounts}}, + ) or pod2usage(-exitval => 1, -verbose => 99, -sections => [qw(SYNOPSIS OPTIONS)]); + + $opts{input} = shift @args if !$opts{input}; + if (!$opts{input}) { + print STDERR "Input file is required.\n"; + exit(1); + } + + return \%opts; +} + +sub _split_tags { + my $tags = shift; + return [split(/\h+/, $tags || '')]; +} + +1; diff --git a/lib/App/HomeBank2Ledger/Formatter.pm b/lib/App/HomeBank2Ledger/Formatter.pm new file mode 100644 index 0000000..1417709 --- /dev/null +++ b/lib/App/HomeBank2Ledger/Formatter.pm @@ -0,0 +1,99 @@ +package App::HomeBank2Ledger::Formatter; +# ABSTRACT: Abstract class for formatting a ledger + +=head1 SYNOPSIS + + my $formatter = App::HomeBank2Ledger::Formatter->new( + type => 'ledger', + ); + print $formatter->format($ledger); + +=head1 DESCRIPTION + +This class formats L as for a file. + +=head1 SEE ALSO + +=for :list +* L +* L + +=cut + +use warnings; +use strict; + +use Module::Load; +use Module::Pluggable search_path => [__PACKAGE__], + sub_name => 'available_formatters'; + +our $VERSION = '9999.999'; # VERSION + +sub _croak { require Carp; Carp::croak(@_) } + +=method new + + $formatter = App::HomeBank2Ledger::Formatter->new(type => $format); + +Construct a new formatter object. + +=cut + +sub new { + my $class = shift; + my %args = @_; + + my $package = __PACKAGE__; + + if ($class eq $package and my $type = $args{type}) { + # factory + for my $formatter ($class->available_formatters) { + next if lc($formatter) ne lc("${package}::${type}"); + $class = $formatter; + load $class; + last; + } + _croak('Invalid formatter type') if $class eq $package; + } + + return bless {%args}, $class; +} + +=method format + + $str = $formatter->format($ledger); + +Do the actual formatting of ledger data into a serialized form. + +This must be overridden by subclasses. + +=cut + +sub format { + ... +} + +=attr type + +Get the type of formatter. + +=attr name + +Get the name or title of the ledger. + +=attr file + +Get the filepath where the ledger data came from. + +=attr account_width + +Get the number of characters to use for the account column. + +=cut + +sub type { shift->{type} } +sub name { shift->{name} } +sub file { shift->{file} } +sub account_width { shift->{account_width} || 40 } + +1; diff --git a/lib/App/HomeBank2Ledger/Formatter/Beancount.pm b/lib/App/HomeBank2Ledger/Formatter/Beancount.pm new file mode 100644 index 0000000..4c496a8 --- /dev/null +++ b/lib/App/HomeBank2Ledger/Formatter/Beancount.pm @@ -0,0 +1,194 @@ +package App::HomeBank2Ledger::Formatter::Beancount; +# ABSTRACT: Beancount formatter + +=head1 DESCRIPTION + +This is a formatter for L. + +=head1 SEE ALSO + +L + +=cut + +use warnings; +use strict; + +use App::HomeBank2Ledger::Util qw(commify); + +use parent 'App::HomeBank2Ledger::Formatter'; + +our $VERSION = '9999.999'; # VERSION + +my %STATUS_SYMBOLS = ( + cleared => '*', + pending => '!', +); + +sub format { + my $self = shift; + my $ledger = shift; + + my @out = ( + $self->_format_header, + $self->_format_accounts($ledger), + $self->_format_commodities($ledger), + # $self->_format_payees, + # $self->_format_tags, + $self->_format_transactions($ledger), + ); + + return join($/, @out); +} + +sub _format_header { + my $self = shift; + + my @out; + + my $file = $self->file; + push @out, "; Converted from $file using homebank2ledger ${VERSION}"; + + if (my $name = $self->name) { + push @out, "; Name: $name"; + } + + push @out, ''; + + return @out; +} + +sub _format_accounts { + my $self = shift; + my $ledger = shift; + + my @out; + + for my $account (sort @{$ledger->accounts}) { + $account = $self->_munge_account($account); + push @out, "1970-01-01 open $account"; # TODO pick better date? + } + push @out, ''; + + return @out; +} + +sub _format_commodities { + my $self = shift; + my $ledger = shift; + + my @out; + + for my $commodity (@{$ledger->commodities}) { + push @out, "1970-01-01 commodity $commodity->{iso}"; # TODO + push @out, " name: \"$commodity->{name}\"" if $commodity->{name}; + } + + push @out, ''; + + return @out; +} + +sub _format_transactions { + my $self = shift; + my $ledger = shift; + + my @out; + + for my $transaction (@{$ledger->transactions}) { + push @out, $self->_format_transaction($transaction); + } + + return @out; +} + +sub _format_transaction { + my $self = shift; + my $transaction = shift; + + my $account_width = $self->account_width; + + my $date = $transaction->{date}; + my $status = $transaction->{status}; + my $payee = $transaction->{payee} || 'No Payee TODO'; + my $memo = $transaction->{memo} || ''; + my @postings = @{$transaction->{postings}}; + + my @out; + + # figure out the Ledger transaction status + my $status_symbol = $STATUS_SYMBOLS{$status || ''}; + if (!$status_symbol) { + my %posting_statuses = map { ($_->{status} || '') => 1 } @postings; + if (keys(%posting_statuses) == 1) { + my ($status) = keys %posting_statuses; + $status_symbol = $STATUS_SYMBOLS{$status || 'none'} || ''; + $status_symbol .= ' ' if $status_symbol; + } + } + + my $symbol = $status_symbol ? "${status_symbol} " : ''; + push @out, "${date} ${symbol}\"${payee}\" \"$memo\""; # TODO handle proper quoting + $out[-1] =~ s/\h+$//; + + if (my %tags = map { $_ => 1 } map { @{$_->{tags} || []} } @postings) { + my @tags = map { "#$_" } keys %tags; + $out[-1] .= " ".join(' ', @tags); + } + + for my $posting (@postings) { + my @line; + + my $posting_status_symbol = ''; + if (!$status_symbol) { + $posting_status_symbol = $STATUS_SYMBOLS{$posting->{status} || ''} || ''; + } + + my $account = $self->_munge_account($posting->{account}); + + push @line, ($posting_status_symbol ? " $posting_status_symbol " : ' '); + push @line, sprintf("\%-${account_width}s", $account); + push @line, ' '; + push @line, $self->_format_amount($posting->{amount}, $posting->{commodity}) if defined $posting->{amount}; + + push @out, join('', @line); + $out[-1] =~ s/\h+$//; + + # if (my $payee = $posting->{payee}) { + # push @out, " ; Payee: $payee"; + # } + } + + push @out, ''; + + return @out; +} + +sub _format_amount { + my $self = shift; + my $amount = shift; + my $commodity = shift; + + # _croak 'Must provide a valid currency' if !$commodity; + + my $format = "\% .$commodity->{frac}f"; + my ($whole, $fraction) = split(/\./, sprintf($format, $amount)); + + # beancount doesn't support different notations + my $num = join('.', commify($whole), $fraction); + + $num = "$num $commodity->{iso}"; + + return $num; +} + +sub _munge_account { + my $self = shift; + my $account = shift; + $account =~ s/[^A-Za-z0-9:]+/-/g; + $account =~ s/-+/-/g; + $account =~ s/(?:^|(?<=:))([a-z])/uc($1)/eg; + return $account; +} + +1; diff --git a/lib/App/HomeBank2Ledger/Formatter/Ledger.pm b/lib/App/HomeBank2Ledger/Formatter/Ledger.pm new file mode 100644 index 0000000..332be8c --- /dev/null +++ b/lib/App/HomeBank2Ledger/Formatter/Ledger.pm @@ -0,0 +1,204 @@ +package App::HomeBank2Ledger::Formatter::Ledger; +# ABSTRACT: Ledger formatter + +=head1 DESCRIPTION + +This is a formatter for L. + +=head1 SEE ALSO + +L + +=cut + +use warnings; +use strict; + +use App::HomeBank2Ledger::Util qw(commify); + +use parent 'App::HomeBank2Ledger::Formatter'; + +our $VERSION = '9999.999'; # VERSION + +my %STATUS_SYMBOLS = ( + cleared => '*', + pending => '!', +); + +sub format { + my $self = shift; + my $ledger = shift; + + my @out = ( + $self->_format_header, + $self->_format_accounts($ledger), + $self->_format_commodities($ledger), + $self->_format_payees($ledger), + $self->_format_tags($ledger), + $self->_format_transactions($ledger), + ); + + return join($/, @out); +} + +sub _format_header { + my $self = shift; + + my @out; + + my $file = $self->file; + push @out, "; Converted from $file using homebank2ledger ${VERSION}"; + + if (my $name = $self->name) { + push @out, "; Name: $name"; + } + + push @out, ''; + + return @out; +} + +sub _format_accounts { + my $self = shift; + my $ledger = shift; + + my @out; + + push @out, map { "account $_" } sort @{$ledger->accounts}; + push @out, ''; + + return @out; +} + +sub _format_commodities { + my $self = shift; + my $ledger = shift; + + my @out; + + for my $commodity (@{$ledger->commodities}) { + push @out, "commodity $commodity->{symbol}"; + push @out, " note $commodity->{name}" if $commodity->{name}; + push @out, " format $commodity->{format}" if $commodity->{format}; + push @out, " alias $commodity->{iso}" if $commodity->{iso}; + } + + push @out, ''; + + return @out; +} + +sub _format_payees { + my $self = shift; + my $ledger = shift; + + my @out; + + push @out, map { "payee $_" } sort @{$ledger->payees}; + push @out, ''; + + return @out; +} + +sub _format_tags { + my $self = shift; + my $ledger = shift; + + my @out; + + push @out, map { "tag $_" } sort @{$ledger->tags}; + push @out, ''; + + return @out; +} + +sub _format_transactions { + my $self = shift; + my $ledger = shift; + + my @out; + + for my $transaction (@{$ledger->transactions}) { + push @out, $self->_format_transaction($transaction); + } + + return @out; +} + +sub _format_transaction { + my $self = shift; + my $transaction = shift; + + my $account_width = $self->account_width; + + my $date = $transaction->{date}; + my $status = $transaction->{status}; + my $payee = $transaction->{payee} || 'No Payee TODO'; + my $memo = $transaction->{memo} || ''; + my @postings = @{$transaction->{postings}}; + + my @out; + + # figure out the Ledger transaction status + my $status_symbol = $STATUS_SYMBOLS{$status || ''}; + if (!$status_symbol) { + my %posting_statuses = map { ($_->{status} || '') => 1 } @postings; + if (keys(%posting_statuses) == 1) { + my ($status) = keys %posting_statuses; + $status_symbol = $STATUS_SYMBOLS{$status || 'none'} || ''; + $status_symbol .= ' ' if $status_symbol; + } + } + + my $symbol = $status_symbol ? "${status_symbol} " : ''; + push @out, "${date} ${symbol}${payee} ; $memo"; + $out[-1] =~ s/\h+$//; + + for my $posting (@postings) { + my @line; + + my $posting_status_symbol = ''; + if (!$status_symbol) { + $posting_status_symbol = $STATUS_SYMBOLS{$posting->{status} || ''} || ''; + } + + push @line, ($posting_status_symbol ? " $posting_status_symbol " : ' '); + push @line, sprintf("\%-${account_width}s", $posting->{account}); + push @line, ' '; + push @line, $self->_format_amount($posting->{amount}, $posting->{commodity}) if defined $posting->{amount}; + + push @out, join('', @line); + $out[-1] =~ s/\h+$//; + + if (my $payee = $posting->{payee}) { + push @out, " ; Payee: $payee"; + } + + if (my @tags = @{$posting->{tags} || []}) { + push @out, " ; :".join(':', @tags).":"; + } + } + + push @out, ''; + + return @out; +} + +sub _format_amount { + my $self = shift; + my $amount = shift; + my $commodity = shift; + + # _croak 'Must provide a valid currency' if !$commodity; + + my $format = "\% .$commodity->{frac}f"; + my ($whole, $fraction) = split(/\./, sprintf($format, $amount)); + + my $num = join($commodity->{dchar}, commify($whole, $commodity->{gchar}), $fraction); + + $num = $commodity->{syprf} ? "$commodity->{symbol} $num" : "$num $commodity->{symbol}"; + + return $num; +} + +1; diff --git a/lib/App/HomeBank2Ledger/Ledger.pm b/lib/App/HomeBank2Ledger/Ledger.pm new file mode 100644 index 0000000..26e9e57 --- /dev/null +++ b/lib/App/HomeBank2Ledger/Ledger.pm @@ -0,0 +1,178 @@ +package App::HomeBank2Ledger::Ledger; +# ABSTRACT: Ledger data representation + +=head1 SYNOPSIS + + my $ledger = App::HomeBank2Ledger::Ledger->new; + + $ledger->add_payees("Ann's Antiques", "Missy Automative"); + + for my $payee (@{$ledger->payees}) { + print "Payee: $payee\n"; + } + +=head1 DESCRIPTION + +This class provides a unified in-memory representation of a ledger, including associated metadata. + +Here is a specification for the substructures: + +=head2 account + +This is a fully-qualified account name. Names may contain colons for representing a hierarchy of +accounts. Examples: + +=for: list +* "Assets:Bank:Chase1234" +* "Liabilities:Credit Card:CapitalOne" + +=head2 commodity + +This is a hashref like this: + + { + symbol => '$', # required + iso => 'USD', # optional + name => 'US Dollar', # optional + format => '$1000.00', # optional + } + +=head2 payee + +This is just a string with the name of a "payee" or memo/description/narration. + +=head2 tag + +This is just a string with the text of a tag. + +=head2 transaction + +This is a hashref like this: + + { + date => '2019-06-12', # required + payee => 'Malcolm Reynolds', # required + status => 'cleared', # optional; can be "cleared" or "pending" + memo => 'Medical supplies', # optional + postings => [ # required + { + account => 'Some Account', # required + amount => '16.25', # required for at least n-1 postings + commodity => { + symbol => '$', + format => '$1,000.00', + iso => 'USD', + name => 'US Dollar', + syprf => 1, + dchar => '.', + gchar => ',', + frac => 2, + }, + payee => 'Somebody', # optional + memo => 'Whatever', # optional + status => 'pending', # optional; can be "cleared" or "pending" + tags => [qw(niska train-job)], + }, + ... + ], + } + +=cut + +use warnings; +use strict; + +our $VERSION = '9999.999'; # VERSION + +=method new + + $ledger = App::HomeBank2Ledger::Ledger->new(%ledger_data); + +Construct a new ledger instance. + +=cut + +sub new { + my $class = shift; + my %args = @_; + return bless {%args}, $class; +} + +=attr accounts + +Get an arrayref of accounts. + +=attr commodities + +Get an arrayref of commodities. + +=attr payees + +Get an arrayref of payees. + +=attr tags + +Get an arrayref of tags. + +=attr transactions + +Get an arrayref of transactions. + +=cut + +sub accounts { shift->{accounts} || [] } +sub commodities { shift->{commodities} || [] } +sub payees { shift->{payees} || [] } +sub tags { shift->{tags} || [] } +sub transactions { shift->{transactions} || [] } + +=method add_accounts + +Add accounts. + +=method add_commodities + +Add commodities. + +=method add_payees + +Add payees. + +=method add_tags + +Add tags. + +=method add_transactions + +Add transactions. + +=cut + +# TODO - These should validate incoming data. + +sub add_accounts { + my $self = shift; + push @{$self->{accounts}}, @_; +} + +sub add_commodities { + my $self = shift; + push @{$self->{commodities}}, @_; +} + +sub add_payees { + my $self = shift; + push @{$self->{payees}}, @_; +} + +sub add_tags { + my $self = shift; + push @{$self->{tags}}, @_; +} + +sub add_transactions { + my $self = shift; + push @{$self->{transactions}}, @_; +} + +1; diff --git a/lib/App/HomeBank2Ledger/Util.pm b/lib/App/HomeBank2Ledger/Util.pm new file mode 100644 index 0000000..d48f5d6 --- /dev/null +++ b/lib/App/HomeBank2Ledger/Util.pm @@ -0,0 +1,32 @@ +package App::HomeBank2Ledger::Util; +# ABSTRACT: Miscellaneous utility functions + +use warnings; +use strict; + +use Exporter qw(import); + +our $VERSION = '9999.999'; # VERSION + +our @EXPORT_OK = qw(commify); + +=func commify + + $commified = commify($num); + $commified = commify($num, $comma_char); + +Just another commify subroutine. + +=cut + +sub commify { + my $num = shift; + my $comma = shift || ','; + + my $str = reverse $num; + $str =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1$comma/g; + + return scalar reverse $str; +} + +1; diff --git a/lib/File/HomeBank.pm b/lib/File/HomeBank.pm new file mode 100644 index 0000000..31ca39d --- /dev/null +++ b/lib/File/HomeBank.pm @@ -0,0 +1,625 @@ +package File::HomeBank; +# ABSTRACT: Parse HomeBank files + +=head1 SYNOPSIS + + # Functional: + + use File::HomeBank qw(parse_file); + + my $raw_data = parse_file('path/to/homebank.xhb'); + + # Or OOP: + + my $homebank = File::HomeBank->new(file => 'path/to/homebank.xhb'); + + for my $account (@{$homebank->accounts}) { + print "Found account named $account->{name}\n"; + } + +=head1 DESCRIPTION + +This module parses L files. + +=cut + +use warnings; +use strict; + +use App::HomeBank2Ledger::Util qw(commify); +use Exporter qw(import); +use Scalar::Util qw(refaddr); +use Time::Piece; +use XML::Parser::Lite; + +our $VERSION = '9999.999'; # VERSION + +our @EXPORT_OK = qw(parse_string parse_file); + +sub _croak { require Carp; Carp::croak(@_) } +sub _usage { _croak("Usage: @_\n") } + +my %ACCOUNT_TYPES = ( + 0 => 'none', + 1 => 'bank', + 2 => 'cash', + 3 => 'asset', + 4 => 'creditcard', + 5 => 'liability', + 6 => 'stock', + 7 => 'mutualfund', + 8 => 'income', + 9 => 'expense', + 10 => 'equity', +); +my %ACCOUNT_FLAGS = ( + 0 => 'oldbudget', + 1 => 'closed', + 2 => 'added', + 3 => 'changed', + 4 => 'nosummary', + 5 => 'nobudget', + 6 => 'noreport', +); +my %CURRENCY_FLAGS = ( + 1 => 'custom', +); +my %CATEGORY_FLAGS = ( + 0 => 'sub', + 1 => 'income', + 2 => 'custom', + 3 => 'budget', + 4 => 'forced', +); +my %TRANSACTION_FLAGS = ( + 0 => 'oldvalid', + 1 => 'income', + 2 => 'auto', + 3 => 'added', + 4 => 'changed', + 5 => 'oldremind', + 6 => 'cheq2', + 7 => 'limit', + 8 => 'split', +); +my %TRANSACTION_STATUSES = ( + 0 => 'none', + 1 => 'cleared', + 2 => 'reconciled', + 3 => 'remind', + 4 => 'void', +); +my %TRANSACTION_PAYMODES = ( + 0 => 'none', + 1 => 'creditcard', + 2 => 'check', + 3 => 'cash', + 4 => 'transfer', + 5 => 'internaltransfer', + 6 => 'debitcard', + 7 => 'repeatpayment', + 8 => 'epayment', + 9 => 'deposit', + 10 => 'fee', + 11 => 'directdebit', +); + +=method new + + $homebank = File::HomeBank->new(string => $str); + $homebank = File::HomeBank->new(file => $filepath); + +Construct a L. + +=cut + +my %CACHE; + +sub new { + my $class = shift; + my %args = @_; + + my $self; + + if (my $filepath = $args{file}) { + $self = parse_file($filepath); + $self->{file} = $filepath; + } + elsif (my $str = $args{string}) { + $self = parse_string($str); + } + else { + _usage(q{File::HomeBank->new(string => $str)}); + } + + return bless $self, $class; +} + +sub DESTROY { + my $self = shift; + my $in_global_destruction = shift; + delete $CACHE{refaddr($self)} if !$in_global_destruction; +} + +=attr file + +Get the filepath (if parsed from a file). + +=cut + +sub file { + shift->{file}; +} + +=method title + + $title = $homebank->title; + +Get the title or owner property. + +=cut + +sub title { + shift->{properties}{title}; +} + +=method base_currency + + $base_currency = $homebank->base_currency; + +Get the key of the base currency. + +=cut + +sub base_currency { + shift->{properties}{currency}; +} + +=method accounts + +Get an arrayref of accounts. + +=method categories + +Get an arrayref of categories. + +=method currencies + +Get an arrayref of currencies. + +=method payees + +Get an arrayref of payees. + +=method tags + +Get an arrayref of tags. + +=method transactions + +Get an arrayref of transactions. + +=cut + +sub accounts { shift->{accounts} || [] } +sub categories { shift->{categories} || [] } +sub currencies { shift->{currencies} || [] } +sub payees { shift->{payees} || [] } +sub transactions { shift->{transactions} || [] } + +sub tags { + my $self = shift; + + my %tags; + + for my $transaction (@{$self->transactions}) { + for my $tag (split(/\h+/, $transaction->{tags} || '')) { + $tags{$tag} = 1; + } + } + + return [keys %tags]; +} + +=method find_account_by_key + + $account = $homebank->find_account_by_key($key); + +Find a account with the given key. + +=cut + +sub find_account_by_key { + my $self = shift; + my $key = shift or return; + + my $index = $CACHE{refaddr($self)}{account_by_key}; + if (!$index) { + # build index + for my $account (@{$self->accounts}) { + $index->{$account->{key}} = $account; + } + + $CACHE{refaddr($self)}{account_by_key} = $index; + } + + return $index->{$key}; +} + +=method find_currency_by_key + + $currency = $homebank->find_currency_by_key($key); + +Find a currency with the given key. + +=cut + +sub find_currency_by_key { + my $self = shift; + my $key = shift or return; + + my $index = $CACHE{refaddr($self)}{currency_by_key}; + if (!$index) { + # build index + for my $currency (@{$self->currencies}) { + $index->{$currency->{key}} = $currency; + } + + $CACHE{refaddr($self)}{currency_by_key} = $index; + } + + return $index->{$key}; +} + +=method find_category_by_key + + $category = $homebank->find_category_by_key($key); + +Find a category with the given key. + +=cut + +sub find_category_by_key { + my $self = shift; + my $key = shift or return; + + my $index = $CACHE{refaddr($self)}{category_by_key}; + if (!$index) { + # build index + for my $category (@{$self->categories}) { + $index->{$category->{key}} = $category; + } + + $CACHE{refaddr($self)}{category_by_key} = $index; + } + + return $index->{$key}; +} + +=method find_payee_by_key + + $payee = $homebank->find_payee_by_key($key); + +Find a payee with the given key. + +=cut + +sub find_payee_by_key { + my $self = shift; + my $key = shift or return; + + my $index = $CACHE{refaddr($self)}{payee_by_key}; + if (!$index) { + # build index + for my $payee (@{$self->payees}) { + $index->{$payee->{key}} = $payee; + } + + $CACHE{refaddr($self)}{payee_by_key} = $index; + } + + return $index->{$key}; +} + +=method find_transactions_by_transfer_key + + @transactions = $homebank->find_transactions_by_transfer_key($key); + +Find all transactions that share the same transfer key. + +=cut + +sub find_transactions_by_transfer_key { + my $self = shift; + my $key = shift or return; + + my $index = $CACHE{refaddr($self)}{transactions_by_transfer_key}; + if (!$index) { + # build index + for my $transaction (@{$self->transactions}) { + my $xfkey = $transaction->{transfer_key} or next; + push @{$index->{$xfkey} ||= []}, $transaction; + } + + $CACHE{refaddr($self)}{transactions_by_transfer_key} = $index; + } + + return @{$index->{$key} || []}; +} + +=method find_transaction_transfer_pair + + $other_transaction = $homebank->find_transaction_transfer_pair($transaction); + +Given a transaction hashref, return its corresponding transaction if it is an internal transfer. If +the transaction is an internal transaction with a destination account but is orphaned (has no +matching transfer key), this also looks for another orphaned transaction in the destination account +that it can call its partner. + +Returns undef or empty if no corresponding transaction is found. + +=cut + +sub find_transaction_transfer_pair { + my $self = shift; + my $transaction = shift; + + return if $transaction->{paymode} ne 'internaltransfer'; + + my $transfer_key = $transaction->{transfer_key}; + + my @matching = grep { refaddr($_) != refaddr($transaction) } + $self->find_transactions_by_transfer_key($transfer_key); + warn "Found more than two transactions with the same transfer key.\n" if 1 < @matching; + return $matching[0] if @matching; + + warn "Found internal transfer with no tranfer key.\n" if !defined $transfer_key; + + my $dst_account = $self->find_account_by_key($transaction->{dst_account}); + if (!$dst_account) { + warn "Found internal transfer with no destination account.\n"; + return; + } + + my @candidates; + + for my $t (@{$self->transactions}) { + next if $t->{paymode} ne 'internaltransfer'; + next if $t->{account} != $transaction->{dst_account}; + next if $t->{dst_account} != $transaction->{account}; + next if $t->{amount} != -$transaction->{amount}; + + my @matching = $self->find_transactions_by_transfer_key($t->{transfer_key}); + next if 1 < @matching; # other transaction must also be orphaned + + push @candidates, $t; + } + + my $transaction_day = _ymd_to_julian($transaction->{date}); + + # sort the candidates so we can pick the nearest one by date + my @ordered_candidates = + map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { [abs($transaction_day - _ymd_to_julian($_->{date})), $_] } @candidates; + + if (my $winner = $ordered_candidates[0]) { + my $key1 = $transfer_key || '[no key]'; + my $key2 = $winner->{transfer_key} || '[no key]'; + warn "Paired orphaned internal transfer ${key1} and ${key2}.\n"; + return $winner; + } +} + +=method sorted_transactions + + $transations = $homebank->sorted_transactions; + +Get an arrayref of transactions sorted by date (earliest first). + +=cut + +sub sorted_transactions { + my $self = shift; + + my $sorted_transactions = $CACHE{refaddr($self)}{sorted_transactions}; + if (!$sorted_transactions) { + $sorted_transactions = [sort { $a->{date} cmp $b->{date} } @{$self->transactions}]; + + $CACHE{refaddr($self)}{sorted_transactions} = $sorted_transactions; + } + + return $sorted_transactions; +} + +=method full_category_name + + $category_name = $homebank->full_category_name($key); + +Generate the full name for a category, taking category inheritance into consideration. + + Income + Salary <-- + +will become: + + "Income:Salary" + +=cut + +sub full_category_name { + my $self = shift; + my $key = shift or return; + + my $cat = $self->find_category_by_key($key); + + my @categories = ($cat); + + while (my $parent_key = $cat->{parent}) { + $cat = $self->find_category_by_key($parent_key); + unshift @categories, $cat; + } + + return join(':', map { $_->{name} } @categories); +} + +=method format_amount + + $formatted_amount = $homebank->format_amount($amount); + $formatted_amount = $homebank->format_amount($amount, $currency); + +Formats an amount in either the base currency (for the whole file) or in the given currency. +Currency can be a key or the actualy currency structure. + +=cut + +sub format_amount { + my $self = shift; + my $amount = shift; + my $currency = shift || $self->base_currency; + + $currency = $self->find_currency_by_key($currency) if !ref($currency); + _croak 'Must provide a valid currency' if !$currency; + + my $format = "\% .$currency->{frac}f"; + my ($whole, $fraction) = split(/\./, sprintf($format, $amount)); + + my $num = join($currency->{dchar}, commify($whole, $currency->{gchar}), $fraction); + + $num = $currency->{syprf} ? "$currency->{symbol} $num" : "$num $currency->{symbol}"; + + return $num; +} + +=func parse_file + + $homebank_data = parse_file($filepath); + +Read and parse a HomeBank .xhb file from a filesystem. + +=cut + +sub parse_file { + my $filepath = shift or _usage(q{parse_file($filepath)}); + + open(my $fh, '<', $filepath) or die "open failed: $!"; + my $str_in = do { local $/; <$fh> }; + + return parse_string($str_in); +} + +=func parse_string + + $homebank_data = parse_string($str); + +Parse a HomeBank file from a string. + +=cut + +sub parse_string { + my $str = shift or die _usage(q{parse_string($str)}); + + my %properties; + my @accounts; + my @payees; + my @categories; + my @currencies; + my @transactions; + + my $xml_parser = XML::Parser::Lite->new( + Handlers => { + Start => sub { + shift; + my $node = shift; + my %attr = @_; + if ($node eq 'properties') { + $attr{currency} = delete $attr{curr} if $attr{curr}; + %properties = %attr; + } + elsif ($node eq 'account') { + $attr{type} = $ACCOUNT_TYPES{$attr{type} || ''} || 'unknown'; + $attr{bank_name} = delete $attr{bankname} if $attr{bankname}; + $attr{currency} = delete $attr{curr} if $attr{curr}; + $attr{display_position} = delete $attr{pos} if $attr{pos}; + + my $flags = delete $attr{flags} || 0; + while (my ($shift, $name) = each %ACCOUNT_FLAGS) { + $attr{flags}{$name} = $flags & (1 << $shift) ? 1 : 0; + } + + push @accounts, \%attr; + } + elsif ($node eq 'pay') { # payee + push @payees, \%attr; + } + elsif ($node eq 'cur') { # currency + $attr{symbol} = delete $attr{symb} if $attr{symb}; + + my $flags = delete $attr{flags} || 0; + while (my ($shift, $name) = each %CURRENCY_FLAGS) { + $attr{flags}{$name} = $flags & (1 << $shift) ? 1 : 0; + } + + push @currencies, \%attr; + } + elsif ($node eq 'cat') { # category + my $flags = delete $attr{flags} || 0; + while (my ($shift, $name) = each %CATEGORY_FLAGS) { + $attr{flags}{$name} = $flags & (1 << $shift) ? 1 : 0; + } + + push @categories, \%attr; + } + elsif ($node eq 'ope') { # transaction + $attr{paymode} = $TRANSACTION_PAYMODES{$attr{paymode} || ''} || 'unknown'; + $attr{status} = $TRANSACTION_STATUSES{delete $attr{st}} || 'unknown'; + + $attr{transfer_key} = delete $attr{kxfer} if $attr{kxfer}; + $attr{split_amount} = delete $attr{samt} if $attr{samt}; + $attr{split_memo} = delete $attr{smem} if $attr{smem}; + $attr{split_category} = delete $attr{scat} if $attr{scat}; + + $attr{date} = _rdn_to_ymd($attr{date}) if $attr{date}; + + my $flags = delete $attr{flags} || 0; + while (my ($shift, $name) = each %TRANSACTION_FLAGS) { + $attr{flags}{$name} = $flags & (1 << $shift) ? 1 : 0; + } + + push @transactions, \%attr; + } + }, + }, + ); + $xml_parser->parse($str); + + return { + properties => \%properties, + accounts => \@accounts, + payees => \@payees, + categories => \@categories, + currencies => \@currencies, + transactions => \@transactions, + }; +} + +sub _rdn_to_unix_epoch { + my $rdn = shift; + my $jan01_1970 = 719163; + return ($rdn - $jan01_1970) * 86400; +} + +sub _rdn_to_ymd { + my $rdn = shift; + my $epoch = _rdn_to_unix_epoch($rdn); + my $time = gmtime($epoch); + return $time->ymd; +}; + +sub _ymd_to_julian { + my $ymd = shift; + my $t = Time::Piece->strptime($ymd, '%Y-%m-%d'); + return $t->julian_day; +} + +1; -- 2.43.0