Dogcows Code - chaz/homebank2ledger/blob - lib/App/HomeBank2Ledger.pm

   1 package App::HomeBank2Ledger;
   2 # ABSTRACT: A tool to convert HomeBank files to Ledger format
   3
   4 =head1 SYNOPSIS
   5
   6     App::HomeBank2Ledger->main(@args);
   7
   8 =head1 DESCRIPTION
   9
  10 This module is part of the L<homebank2ledger> script.
  11
  12 =cut
  13
  14 use warnings;
  15 use strict;
  16
  17 use App::HomeBank2Ledger::Formatter;
  18 use App::HomeBank2Ledger::Ledger;
  19 use File::HomeBank;
  20 use Getopt::Long 2.38 qw(GetOptionsFromArray);
  21 use Pod::Usage;
  22
  23 our $VERSION = '9999.999'; # VERSION
  24
  25 my %ACCOUNT_TYPES = (   # map HomeBank account types to Ledger accounts
  26     bank        => 'Assets:Bank',
  27     cash        => 'Assets:Cash',
  28     asset       => 'Assets:Fixed Assets',
  29     creditcard  => 'Liabilities:Credit Card',
  30     liability   => 'Liabilities',
  31     stock       => 'Assets:Stock',
  32     mutualfund  => 'Assets:Mutual Fund',
  33     income      => 'Income',
  34     expense     => 'Expenses',
  35     equity      => 'Equity',
  36 );
  37 my %STATUS_SYMBOLS = (
  38     cleared     => 'cleared',
  39     reconciled  => 'cleared',
  40     remind      => 'pending',
  41 );
  42 my $UNKNOWN_ACCOUNT = 'Assets:Unknown';
  43 my $OPENING_BALANCES_ACCOUNT = 'Equity:Opening Balances';
  44
  45 =method main
  46
  47     App::HomeBank2Ledger->main(@args);
  48
  49 Run the script and exit; does not return.
  50
  51 =cut
  52
  53 sub main {
  54     my $class = shift;
  55     my $self  = bless {}, $class;
  56
  57     my $opts = $self->parse_args(@_);
  58
  59     if ($opts->{version}) {
  60         print "homebank2ledger ${VERSION}\n";
  61         exit 0;
  62     }
  63     if ($opts->{help}) {
  64         pod2usage(-exitval => 0, -verbose => 99, -sections => [qw(NAME SYNOPSIS OPTIONS)]);
  65     }
  66     if ($opts->{manual}) {
  67         pod2usage(-exitval => 0, -verbose => 2);
  68     }
  69     if (!$opts->{input}) {
  70         print STDERR "Input file is required.\n";
  71         exit(1);
  72     }
  73
  74     my $homebank = File::HomeBank->new(file => $opts->{input});
  75
  76     my $formatter = eval { $self->formatter($homebank, $opts) };
  77     if (my $err = $@) {
  78         if ($err =~ /^Invalid formatter/) {
  79             print STDERR "Invalid format: $opts->{format}\n";
  80             exit 2;
  81         }
  82         die $err;
  83     }
  84
  85     my $ledger = $self->convert_homebank_to_ledger($homebank, $opts);
  86
  87     $self->print_to_file($formatter->format($ledger), $opts->{output});
  88
  89     exit 0;
  90 }
  91
  92 =method formatter
  93
  94     $formatter = $app->formatter($homebank, $opts);
  95
  96 Generate a L<App::HomeBank2Ledger::Formatter>.
  97
  98 =cut
  99
 100 sub formatter {
 101     my $self     = shift;
 102     my $homebank = shift;
 103     my $opts     = shift || {};
 104
 105     return App::HomeBank2Ledger::Formatter->new(
 106         type            => $opts->{format},
 107         account_width   => $opts->{account_width},
 108         name            => $homebank->title,
 109         file            => $homebank->file,
 110     );
 111 }
 112
 113 =method convert_homebank_to_ledger
 114
 115     my $ledger = $app->convert_homebank_to_ledger($homebank, $opts);
 116
 117 Converts a L<File::HomeBank> to a L<App::HomeBank2Ledger::Ledger>.
 118
 119 =cut
 120
 121 sub convert_homebank_to_ledger {
 122     my $self     = shift;
 123     my $homebank = shift;
 124     my $opts     = shift || {};
 125
 126     my $default_account_income   = 'Income:Unknown';
 127     my $default_account_expenses = 'Expenses:Unknown';
 128
 129     my $ledger = App::HomeBank2Ledger::Ledger->new;
 130
 131     my $transactions    = $homebank->sorted_transactions;
 132     my $accounts        = $homebank->accounts;
 133     my $categories      = $homebank->categories;
 134     my @budget;
 135
 136     # determine full Ledger account names
 137     for my $account (@$accounts) {
 138         my $type = $ACCOUNT_TYPES{$account->{type}} || $UNKNOWN_ACCOUNT;
 139         $account->{ledger_name} = "${type}:$account->{name}";
 140     }
 141     for my $category (@$categories) {
 142         my $type = $category->{flags}{income} ? 'Income' : 'Expenses';
 143         my $full_name = $homebank->full_category_name($category->{key});
 144         $category->{ledger_name} = "${type}:${full_name}";
 145
 146         if ($opts->{budget} && $category->{flags}{budget}) {
 147             for my $month_num ($category->{flags}{custom} ? (1 .. 12) : 0) {
 148                 my $amount = $category->{budget_amounts}[$month_num] || 0;
 149                 next if !$amount && !$category->{flags}{forced};
 150
 151                 $budget[$month_num]{$category->{ledger_name}} = $amount;
 152             }
 153         }
 154     }
 155
 156     # handle renaming and marking excluded accounts
 157     for my $item (@$accounts, @$categories) {
 158         while (my ($re, $replacement) = each %{$opts->{rename_accounts}}) {
 159             $item->{ledger_name} =~ s/$re/$replacement/;
 160         }
 161         for my $re (@{$opts->{exclude_accounts}}) {
 162             $item->{excluded} = 1 if $item->{ledger_name} =~ /$re/;
 163         }
 164     }
 165     while (my ($re, $replacement) = each %{$opts->{rename_accounts}}) {
 166         $default_account_income   =~ s/$re/$replacement/;
 167         $default_account_expenses =~ s/$re/$replacement/;
 168     }
 169
 170     my $has_initial_balance = grep { $_->{initial} && !$_->{excluded} } @$accounts;
 171
 172     if ($opts->{accounts}) {
 173         my @accounts = map { $_->{ledger_name} } grep { !$_->{excluded} } @$accounts, @$categories;
 174
 175         push @accounts, $default_account_income   if !grep { $_ eq $default_account_income   } @accounts;
 176         push @accounts, $default_account_expenses if !grep { $_ eq $default_account_expenses } @accounts;
 177         push @accounts, $OPENING_BALANCES_ACCOUNT if $has_initial_balance;
 178
 179         $ledger->add_accounts(@accounts);
 180     }
 181
 182     if ($opts->{payees}) {
 183         my $payees = $homebank->payees;
 184         my @payees = map { $_->{name} } @$payees;
 185
 186         $ledger->add_payees(@payees);
 187     }
 188
 189     if ($opts->{tags}) {
 190         my $tags = $homebank->tags;
 191
 192         $ledger->add_tags(@$tags);
 193     }
 194
 195     my %commodities;
 196
 197     for my $currency (@{$homebank->currencies}) {
 198         my $commodity = {
 199             symbol  => $currency->{symbol},
 200             format  => $homebank->format_amount(1_000, $currency),
 201             iso     => $currency->{iso},
 202             name    => $currency->{name},
 203         };
 204         $commodities{$currency->{key}} = {
 205             %$commodity,
 206             syprf   => $currency->{syprf},
 207             dchar   => $currency->{dchar},
 208             gchar   => $currency->{gchar},
 209             frac    => $currency->{frac},
 210         };
 211
 212         $ledger->add_commodities($commodity) if $opts->{commodities};
 213     }
 214
 215     my $first_date;
 216     if ($has_initial_balance) {
 217         # transactions are sorted, so the first transaction is the oldest
 218         $first_date = $opts->{opening_date} || $transactions->[0]{date};
 219         if ($first_date !~ /^\d{4}-\d{2}-\d{2}$/) {
 220             die "Opening date must be in the form YYYY-MM-DD.\n";
 221         }
 222
 223         my @postings;
 224
 225         for my $account (@$accounts) {
 226             next if !$account->{initial} || $account->{excluded};
 227
 228             push @postings, {
 229                 account     => $account->{ledger_name},
 230                 amount      => $account->{initial},
 231                 commodity   => $commodities{$account->{currency}},
 232             };
 233         }
 234
 235         push @postings, {
 236             account => $OPENING_BALANCES_ACCOUNT,
 237         };
 238
 239         $ledger->add_transactions({
 240             date        => $first_date,
 241             payee       => 'Opening Balance',
 242             status      => 'cleared',
 243             postings    => \@postings,
 244         });
 245     }
 246
 247     if ($opts->{budget}) {
 248         my ($first_year) = $first_date =~ /^(\d{4})/;
 249
 250         for my $month_num (0 .. 12) {
 251             next if !$budget[$month_num];
 252
 253             my $payee = 'Monthly';
 254             if (0 < $month_num) {
 255                 my $year = $first_year;
 256                 $year += 1 if sprintf('%04d-%02d-99', $first_year, $month_num) lt $first_date;
 257                 my $date = sprintf('%04d-%02d', $year, $month_num);
 258                 $payee = "Every 12 months from ${date}";
 259             }
 260             # my @MONTHS = qw(ALL Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 261             # $payee = "Monthly this $MONTHS[$month_num]" if 0 < $month_num;
 262
 263             my @postings;
 264
 265             for my $account (sort keys %{$budget[$month_num]}) {
 266                 my $amount = $budget[$month_num]{$account};
 267                 push @postings, {
 268                     account     => $account,
 269                     amount      => -$amount,
 270                     commodity   => $commodities{$homebank->base_currency},
 271                 }
 272             }
 273             push @postings, {
 274                 account => 'Assets',
 275             };
 276
 277             $ledger->add_transactions({
 278                 date        => '~',
 279                 payee       => $payee,
 280                 postings    => \@postings,
 281             });
 282         }
 283     }
 284
 285     my %seen;
 286
 287     TRANSACTION:
 288     for my $transaction (@$transactions) {
 289         next if $seen{$transaction->{transfer_key} || ''};
 290
 291         my $account = $homebank->find_account_by_key($transaction->{account});
 292         my $amount  = $transaction->{amount};
 293         my $status  = $STATUS_SYMBOLS{$transaction->{status} || ''} || '';
 294         my $memo    = $transaction->{wording} || '';
 295         my $payee   = $homebank->find_payee_by_key($transaction->{payee});
 296         my $tags    = _split_tags($transaction->{tags});
 297
 298         my @postings;
 299
 300         push @postings, {
 301             account     => $account->{ledger_name},
 302             amount      => $amount,
 303             commodity   => $commodities{$account->{currency}},
 304             payee       => $payee->{name},
 305             note        => $memo,
 306             status      => $status,
 307             tags        => $tags,
 308         };
 309
 310         if ($transaction->{dst_account}) {  # is an internal transfer
 311             my $paired_transaction = $homebank->find_transaction_transfer_pair($transaction);
 312
 313             my $dst_account = $homebank->find_account_by_key($transaction->{dst_account});
 314             if (!$dst_account) {
 315                 if ($paired_transaction) {
 316                     $dst_account = $homebank->find_account_by_key($paired_transaction->{account});
 317                 }
 318                 if (!$dst_account) {
 319                     warn "Skipping internal transfer transaction with no destination account.\n";
 320                     next TRANSACTION;
 321                 }
 322             }
 323
 324             $seen{$transaction->{transfer_key}}++        if $transaction->{transfer_key};
 325             $seen{$paired_transaction->{transfer_key}}++ if $paired_transaction->{transfer_key};
 326
 327             my $paired_payee = $homebank->find_payee_by_key($paired_transaction->{payee});
 328
 329             push @postings, {
 330                 account     => $dst_account->{ledger_name},
 331                 amount      => $paired_transaction->{amount} || -$transaction->{amount},
 332                 commodity   => $commodities{$dst_account->{currency}},
 333                 payee       => $paired_payee->{name},
 334                 note        => $paired_transaction->{wording} || '',
 335                 status      => $STATUS_SYMBOLS{$paired_transaction->{status} || ''} || $status,
 336                 tags        => _split_tags($paired_transaction->{tags}),
 337             };
 338         }
 339         elsif ($transaction->{flags}{split}) {
 340             my @amounts     = split(/\|\|/, $transaction->{split_amount}   || '');
 341             my @memos       = split(/\|\|/, $transaction->{split_memo}     || '');
 342             my @categories  = split(/\|\|/, $transaction->{split_category} || '');
 343
 344             for (my $i = 0; $amounts[$i]; ++$i) {
 345                 my $amount          = -$amounts[$i];
 346                 my $category        = $homebank->find_category_by_key($categories[$i]);
 347                 my $memo            = $memos[$i] || '';
 348                 my $other_account   = $category   ? $category->{ledger_name}
 349                                     : $amount < 0 ? $default_account_income
 350                                     :               $default_account_expenses;
 351
 352                 push @postings, {
 353                     account     => $other_account,
 354                     commodity   => $commodities{$account->{currency}},
 355                     amount      => $amount,
 356                     payee       => $payee->{name},
 357                     note        => $memo,
 358                     status      => $status,
 359                     tags        => $tags,
 360                 };
 361             }
 362         }
 363         else {  # with or without category
 364             my $amount          = -$transaction->{amount};
 365             my $category        = $homebank->find_category_by_key($transaction->{category});
 366             my $other_account   = $category   ? $category->{ledger_name}
 367                                 : $amount < 0 ? $default_account_income
 368                                 :               $default_account_expenses;
 369
 370             push @postings, {
 371                 account     => $other_account,
 372                 commodity   => $commodities{$account->{currency}},
 373                 amount      => $amount,
 374                 payee       => $payee->{name},
 375                 note        => $memo,
 376                 status      => $status,
 377                 tags        => $tags,
 378             };
 379         }
 380
 381         # skip excluded accounts
 382         for my $posting (@postings) {
 383             for my $re (@{$opts->{exclude_accounts}}) {
 384                 next TRANSACTION if $posting->{account} =~ /$re/;
 385             }
 386         }
 387
 388         $ledger->add_transactions({
 389             date        => $transaction->{date},
 390             payee       => $payee->{name},
 391             memo        => $memo,
 392             postings    => \@postings,
 393         });
 394     }
 395
 396     return $ledger;
 397 }
 398
 399 =method print_to_file
 400
 401     $app->print_to_file($str);
 402     $app->print_to_file($str, $filepath);
 403
 404 Print a string to a file (or STDOUT).
 405
 406 =cut
 407
 408 sub print_to_file {
 409     my $self     = shift;
 410     my $str      = shift;
 411     my $filepath = shift;
 412
 413     my $out_fh = \*STDOUT;
 414     if ($filepath) {
 415         open($out_fh, '>', $filepath) or die "open failed: $!";
 416     }
 417     print $out_fh $str;
 418 }
 419
 420 =method parse_args
 421
 422     $opts = $app->parse_args(@args);
 423
 424 Parse command-line arguments.
 425
 426 =cut
 427
 428 sub parse_args {
 429     my $self = shift;
 430     my @args = @_;
 431
 432     my %opts = (
 433         version             => 0,
 434         help                => 0,
 435         manual              => 0,
 436         input               => undef,
 437         output              => undef,
 438         format              => 'ledger',
 439         account_width       => 40,
 440         accounts            => 1,
 441         payees              => 1,
 442         tags                => 1,
 443         commodities         => 1,
 444         budget              => 1,
 445         opening_date        => '',
 446         rename_accounts     => {},
 447         exclude_accounts    => [],
 448     );
 449
 450     GetOptionsFromArray(\@args,
 451         'version|V'             => \$opts{version},
 452         'help|h|?'              => \$opts{help},
 453         'manual|man'            => \$opts{manual},
 454         'input|file|i=s'        => \$opts{input},
 455         'output|o=s'            => \$opts{output},
 456         'format|f=s'            => \$opts{format},
 457         'account-width=i'       => \$opts{account_width},
 458         'accounts!'             => \$opts{accounts},
 459         'payees!'               => \$opts{payees},
 460         'tags!'                 => \$opts{tags},
 461         'commodities!'          => \$opts{commodities},
 462         'budget!'               => \$opts{budget},
 463         'opening-date=s'        => \$opts{opening_date},
 464         'rename-account|r=s'    => \%{$opts{rename_accounts}},
 465         'exclude-account|x=s'   => \@{$opts{exclude_accounts}},
 466     ) or pod2usage(-exitval => 1, -verbose => 99, -sections => [qw(SYNOPSIS OPTIONS)]);
 467
 468     $opts{input}  = shift @args if !$opts{input};
 469     $opts{budget} = 0 if lc($opts{format}) ne 'ledger';
 470
 471     return \%opts;
 472 }
 473
 474 sub _split_tags {
 475     my $tags = shift;
 476     return [split(/\h+/, $tags || '')];
 477 }
 478
 479 1;