initial commit
authorCharles McGarvey <chazmcgarvey@brokenzipper.com>
Thu, 13 Jun 2019 00:42:32 +0000 (18:42 -0600)
committerCharles McGarvey <chazmcgarvey@brokenzipper.com>
Thu, 13 Jun 2019 00:57:06 +0000 (18:57 -0600)
13 files changed:
.editorconfig [new file with mode: 0644]
.gitignore [new file with mode: 0644]
Changes [new file with mode: 0644]
Makefile [new file with mode: 0644]
bin/homebank2ledger [new file with mode: 0644]
dist.ini [new file with mode: 0644]
lib/App/HomeBank2Ledger.pm [new file with mode: 0644]
lib/App/HomeBank2Ledger/Formatter.pm [new file with mode: 0644]
lib/App/HomeBank2Ledger/Formatter/Beancount.pm [new file with mode: 0644]
lib/App/HomeBank2Ledger/Formatter/Ledger.pm [new file with mode: 0644]
lib/App/HomeBank2Ledger/Ledger.pm [new file with mode: 0644]
lib/App/HomeBank2Ledger/Util.pm [new file with mode: 0644]
lib/File/HomeBank.pm [new file with mode: 0644]

diff --git a/.editorconfig b/.editorconfig
new file mode 100644 (file)
index 0000000..7809e2d
--- /dev/null
@@ -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 (file)
index 0000000..c1d1498
--- /dev/null
@@ -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 (file)
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 (file)
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 (file)
index 0000000..d4a433f
--- /dev/null
@@ -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<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);
diff --git a/dist.ini b/dist.ini
new file mode 100644 (file)
index 0000000..5e951ae
--- /dev/null
+++ b/dist.ini
@@ -0,0 +1,15 @@
+
+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]
+
diff --git a/lib/App/HomeBank2Ledger.pm b/lib/App/HomeBank2Ledger.pm
new file mode 100644 (file)
index 0000000..52f4267
--- /dev/null
@@ -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<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;
diff --git a/lib/App/HomeBank2Ledger/Formatter.pm b/lib/App/HomeBank2Ledger/Formatter.pm
new file mode 100644 (file)
index 0000000..1417709
--- /dev/null
@@ -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<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;
diff --git a/lib/App/HomeBank2Ledger/Formatter/Beancount.pm b/lib/App/HomeBank2Ledger/Formatter/Beancount.pm
new file mode 100644 (file)
index 0000000..4c496a8
--- /dev/null
@@ -0,0 +1,194 @@
+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;
diff --git a/lib/App/HomeBank2Ledger/Formatter/Ledger.pm b/lib/App/HomeBank2Ledger/Formatter/Ledger.pm
new file mode 100644 (file)
index 0000000..332be8c
--- /dev/null
@@ -0,0 +1,204 @@
+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;
diff --git a/lib/App/HomeBank2Ledger/Ledger.pm b/lib/App/HomeBank2Ledger/Ledger.pm
new file mode 100644 (file)
index 0000000..26e9e57
--- /dev/null
@@ -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 (file)
index 0000000..d48f5d6
--- /dev/null
@@ -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 (file)
index 0000000..31ca39d
--- /dev/null
@@ -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<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;
This page took 0.063409 seconds and 4 git commands to generate.