--- /dev/null
+
+# 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
+
--- /dev/null
+*#
+*.bs
+*.o
+*.tar*
+*~
+/.build
+/.perl-version
+/MYMETA.*
+/blib
+/cover_db
+/homebank2ledger-*
+/local*
+/pm_to_blib
+/tmp
--- /dev/null
+Revision history for homebank2ledger.
+
+{{$NEXT}}
+
--- /dev/null
+
+# 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
+
--- /dev/null
+#! 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<homebank2ledger> converts L<HomeBank|http://homebank.free.fr/> files to a format usable by
+L<Ledger|https://www.ledger-cli.org/>. It can also convert directly to the similar
+L<Beancount|http://furius.ca/beancount/> format.
+
+This software is B<EXPERIMENTAL>. 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<STDOUT>.
+
+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<homebank2ledger> 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</EXAMPLES>.
+
+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</"--rename-account STR"> 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);
--- /dev/null
+
+name = homebank2ledger
+main_module = lib/App/HomeBank2Ledger.pm
+author = Charles McGarvey <chazmcgarvey@brokenzipper.com>
+copyright_holder = Charles McGarvey
+copyright_year = 2019
+license = MIT
+
+[@Filter]
+-bundle = @Author::CCM
+-remove = Test::CleanNamespaces
+max_target_perl = 5.14
+
+[ConsistentVersionTest]
+
--- /dev/null
+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<homebank2ledger> 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<App::HomeBank2Ledger::Formatter>.
+
+=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<File::HomeBank> to a L<App::HomeBank2Ledger::Ledger>.
+
+=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;
--- /dev/null
+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<ledger data|App::HomeBank2Ledger::Ledger> as for a file.
+
+=head1 SEE ALSO
+
+=for :list
+* L<App::HomeBank2Ledger::Formatter::Beancount>
+* L<App::HomeBank2Ledger::Formatter::Ledger>
+
+=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;
--- /dev/null
+package App::HomeBank2Ledger::Formatter::Beancount;
+# ABSTRACT: Beancount formatter
+
+=head1 DESCRIPTION
+
+This is a formatter for L<Beancount|http://furius.ca/beancount/>.
+
+=head1 SEE ALSO
+
+L<App::HomeBank2Ledger::Formatter>
+
+=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;
--- /dev/null
+package App::HomeBank2Ledger::Formatter::Ledger;
+# ABSTRACT: Ledger formatter
+
+=head1 DESCRIPTION
+
+This is a formatter for L<Ledger|https://www.ledger-cli.org/>.
+
+=head1 SEE ALSO
+
+L<App::HomeBank2Ledger::Formatter>
+
+=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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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<HomeBank|http://homebank.free.fr/> 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<File::HomeBank>.
+
+=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;
projects / chaz / homebank2ledger / commitdiff
