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 FATAL => 'all';    # temp fatal all
  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
  70     my $homebank = File::HomeBank->new(file => $opts->{input});
  71
  72     my $formatter = eval { $self->formatter($homebank, $opts) };
  73     if (my $err = $@) {
  74         if ($err =~ /^Invalid formatter/) {
  75             print STDERR "Invalid format: $opts->{format}\n";
  76             exit 2;
  77         }
  78         die $err;
  79     }
  80
  81     my $ledger = $self->convert_homebank_to_ledger($homebank, $opts);
  82
  83     $self->print_to_file($formatter->format($ledger), $opts->{output});
  84
  85     exit 0;
  86 }
  87
  88 =method formatter
  89
  90     $formatter = $app->formatter($homebank, $opts);
  91
  92 Generate a L<App::HomeBank2Ledger::Formatter>.
  93
  94 =cut
  95
  96 sub formatter {
  97     my $self     = shift;
  98     my $homebank = shift;
  99     my $opts     = shift || {};
 100
 101     return App::HomeBank2Ledger::Formatter->new(
 102         type            => $opts->{format},
 103         account_width   => $opts->{account_width},
 104         name            => $homebank->title,
 105         file            => $homebank->file,
 106     );
 107 }
 108
 109 =method convert_homebank_to_ledger
 110
 111     my $ledger = $app->convert_homebank_to_ledger($homebank, $opts);
 112
 113 Converts a L<File::HomeBank> to a L<App::HomeBank2Ledger::Ledger>.
 114
 115 =cut
 116
 117 sub convert_homebank_to_ledger {
 118     my $self     = shift;
 119     my $homebank = shift;
 120     my $opts     = shift || {};
 121
 122     my $ledger = App::HomeBank2Ledger::Ledger->new;
 123
 124     my $transactions    = $homebank->sorted_transactions;
 125     my $accounts        = $homebank->accounts;
 126     my $categories      = $homebank->categories;
 127
 128     # determine full Ledger account names
 129     for my $account (@$accounts) {
 130         my $type = $ACCOUNT_TYPES{$account->{type}} || $UNKNOWN_ACCOUNT;
 131         $account->{ledger_name} = "${type}:$account->{name}";
 132     }
 133     for my $category (@$categories) {
 134         my $type = $category->{flags}{income} ? 'Income' : 'Expenses';
 135         my $full_name = $homebank->full_category_name($category->{key});
 136         $category->{ledger_name} = "${type}:${full_name}";
 137     }
 138
 139     # handle renaming and marking excluded accounts
 140     for my $item (@$accounts, @$categories) {
 141         while (my ($re, $replacement) = each %{$opts->{rename_accounts}}) {
 142             $item->{ledger_name} =~ s/$re/$replacement/;
 143         }
 144         for my $re (@{$opts->{exclude_accounts}}) {
 145             $item->{excluded} = 1 if $item->{ledger_name} =~ /$re/;
 146         }
 147     }
 148
 149     my $has_initial_balance = grep { $_->{initial} && !$_->{excluded} } @$accounts;
 150
 151     if ($opts->{accounts}) {
 152         my @accounts = map { $_->{ledger_name} } grep { !$_->{excluded} } @$accounts, @$categories;
 153
 154         push @accounts, $opts->{default_account};
 155         push @accounts, $OPENING_BALANCES_ACCOUNT if $has_initial_balance;
 156
 157         $ledger->add_accounts(@accounts);
 158     }
 159
 160     if ($opts->{payees}) {
 161         my $payees = $homebank->payees;
 162         my @payees = map { $_->{name} } @$payees;
 163
 164         $ledger->add_payees(@payees);
 165     }
 166
 167     if ($opts->{tags}) {
 168         my $tags = $homebank->tags;
 169
 170         $ledger->add_tags(@$tags);
 171     }
 172
 173     my %commodities;
 174
 175     for my $currency (@{$homebank->currencies}) {
 176         my $commodity = {
 177             symbol  => $currency->{symbol},
 178             format  => $homebank->format_amount(1_000, $currency),
 179             iso     => $currency->{iso},
 180             name    => $currency->{name},
 181         };
 182         $commodities{$currency->{key}} = {
 183             %$commodity,
 184             syprf   => $currency->{syprf},
 185             dchar   => $currency->{dchar},
 186             gchar   => $currency->{gchar},
 187             frac    => $currency->{frac},
 188         };
 189
 190         $ledger->add_commodities($commodity) if $opts->{commodities};
 191     }
 192
 193     if ($has_initial_balance) {
 194         # transactions are sorted, so the first transaction is the oldest
 195         my $first_date = $opts->{opening_date} || $transactions->[0]{date};
 196         if ($first_date !~ /^\d{4}-\d{2}-\d{2}$/) {
 197             die "Opening date must be in the form YYYY-MM-DD.\n";
 198         }
 199
 200         my @postings;
 201
 202         for my $account (@$accounts) {
 203             next if !$account->{initial} || $account->{excluded};
 204
 205             push @postings, {
 206                 account     => $account->{ledger_name},
 207                 amount      => $account->{initial},
 208                 commodity   => $commodities{$account->{currency}},
 209             };
 210         }
 211
 212         push @postings, {
 213             account => $OPENING_BALANCES_ACCOUNT,
 214         };
 215
 216         $ledger->add_transactions({
 217             date        => $first_date,
 218             payee       => 'Opening Balance',
 219             status      => 'cleared',
 220             postings    => \@postings,
 221         });
 222     }
 223
 224     my %seen;
 225
 226     TRANSACTION:
 227     for my $transaction (@$transactions) {
 228         next if $seen{$transaction->{transfer_key} || ''};
 229
 230         my $account = $homebank->find_account_by_key($transaction->{account});
 231         my $amount  = $transaction->{amount};
 232         my $status  = $STATUS_SYMBOLS{$transaction->{status} || ''} || '';
 233         my $paymode = $transaction->{paymode} || ''; # internaltransfer
 234         my $memo    = $transaction->{wording} || '';
 235         my $payee   = $homebank->find_payee_by_key($transaction->{payee});
 236         my $tags    = _split_tags($transaction->{tags});
 237
 238         my @postings;
 239
 240         push @postings, {
 241             account     => $account->{ledger_name},
 242             amount      => $amount,
 243             commodity   => $commodities{$account->{currency}},
 244             payee       => $payee->{name},
 245             memo        => $memo,
 246             status      => $status,
 247             tags        => $tags,
 248         };
 249
 250         if ($paymode eq 'internaltransfer') {
 251             my $paired_transaction = $homebank->find_transaction_transfer_pair($transaction);
 252
 253             my $dst_account = $homebank->find_account_by_key($transaction->{dst_account});
 254             if (!$dst_account) {
 255                 if ($paired_transaction) {
 256                     $dst_account = $homebank->find_account_by_key($paired_transaction->{account});
 257                 }
 258                 if (!$dst_account) {
 259                     warn "Skipping internal transfer transaction with no destination account.\n";
 260                     next TRANSACTION;
 261                 }
 262             }
 263
 264             $seen{$transaction->{transfer_key}}++        if $transaction->{transfer_key};
 265             $seen{$paired_transaction->{transfer_key}}++ if $paired_transaction->{transfer_key};
 266
 267             my $paired_payee = $homebank->find_payee_by_key($paired_transaction->{payee});
 268
 269             push @postings, {
 270                 account     => $dst_account->{ledger_name},
 271                 amount      => $paired_transaction->{amount} || -$transaction->{amount},
 272                 commodity   => $commodities{$dst_account->{currency}},
 273                 payee       => $paired_payee->{name},
 274                 memo        => $paired_transaction->{wording} || '',
 275                 status      => $STATUS_SYMBOLS{$paired_transaction->{status} || ''} || $status,
 276                 tags        => _split_tags($paired_transaction->{tags}),
 277             };
 278         }
 279         elsif ($transaction->{flags}{split}) {
 280             my @amounts     = split(/\|\|/, $transaction->{split_amount}   || '');
 281             my @memos       = split(/\|\|/, $transaction->{split_memo}     || '');
 282             my @categories  = split(/\|\|/, $transaction->{split_category} || '');
 283
 284             for (my $i = 0; $amounts[$i]; ++$i) {
 285                 my $amount        = -$amounts[$i];
 286                 my $category      = $homebank->find_category_by_key($categories[$i]);
 287                 my $memo          = $memos[$i] || '';
 288                 my $other_account = $category ? $category->{ledger_name} : $opts->{default_account};
 289
 290                 push @postings, {
 291                     account     => $other_account,
 292                     commodity   => $commodities{$account->{currency}},
 293                     amount      => $amount,
 294                     payee       => $payee->{name},
 295                     memo        => $memo,
 296                     status      => $status,
 297                     tags        => $tags,
 298                 };
 299             }
 300         }
 301         else {  # with or without category
 302             my $category      = $homebank->find_category_by_key($transaction->{category});
 303             my $other_account = $category ? $category->{ledger_name} : $opts->{default_account};
 304             push @postings, {
 305                 account     => $other_account,
 306                 commodity   => $commodities{$account->{currency}},
 307                 amount      => -$transaction->{amount},
 308                 payee       => $payee->{name},
 309                 memo        => $memo,
 310                 status      => $status,
 311                 tags        => $tags,
 312             };
 313         }
 314
 315         # skip excluded accounts
 316         for my $posting (@postings) {
 317             for my $re (@{$opts->{exclude_accounts}}) {
 318                 next TRANSACTION if $posting->{account} =~ /$re/;
 319             }
 320         }
 321
 322         $ledger->add_transactions({
 323             date        => $transaction->{date},
 324             payee       => $payee->{name},
 325             memo        => $memo,
 326             postings    => \@postings,
 327         });
 328     }
 329
 330     return $ledger;
 331 }
 332
 333 =method print_to_file
 334
 335     $app->print_to_file($str);
 336     $app->print_to_file($str, $filepath);
 337
 338 Print a string to a file (or STDOUT).
 339
 340 =cut
 341
 342 sub print_to_file {
 343     my $self     = shift;
 344     my $str      = shift;
 345     my $filepath = shift;
 346
 347     my $out_fh = \*STDOUT;
 348     if ($filepath) {
 349         open($out_fh, '>', $filepath) or die "open failed: $!";
 350     }
 351     print $out_fh $str;
 352 }
 353
 354 =method parse_args
 355
 356     $opts = $app->parse_args(@args);
 357
 358 Parse command-line arguments.
 359
 360 =cut
 361
 362 sub parse_args {
 363     my $self = shift;
 364     my @args = @_;
 365
 366     my %opts = (
 367         version             => 0,
 368         help                => 0,
 369         manual              => 0,
 370         input               => undef,
 371         output              => undef,
 372         format              => 'ledger',
 373         account_width       => 40,
 374         accounts            => 1,
 375         payees              => 1,
 376         tags                => 1,
 377         commodities         => 1,
 378         opening_date        => '',
 379         default_account     => 'Expenses:No Category',
 380         rename_accounts     => {},
 381         exclude_accounts    => [],
 382     );
 383
 384     GetOptionsFromArray(\@args,
 385         'version|V'             => \$opts{version},
 386         'help|h|?'              => \$opts{help},
 387         'manual|man'            => \$opts{manual},
 388         'input|file|i=s'        => \$opts{input},
 389         'output|o=s'            => \$opts{output},
 390         'format|f=s'            => \$opts{format},
 391         'account-width=i'       => \$opts{account_width},
 392         'accounts!'             => \$opts{accounts},
 393         'payees!'               => \$opts{payees},
 394         'tags!'                 => \$opts{tags},
 395         'commodities!'          => \$opts{commodities},
 396         'opening-date=s'        => \$opts{opening_date},
 397         'default-account=s'     => \$opts{default_account},
 398         'rename-account|r=s'    => \%{$opts{rename_accounts}},
 399         'exclude-account|x=s'   => \@{$opts{exclude_accounts}},
 400     ) or pod2usage(-exitval => 1, -verbose => 99, -sections => [qw(SYNOPSIS OPTIONS)]);
 401
 402     $opts{input} = shift @args if !$opts{input};
 403     if (!$opts{input}) {
 404         print STDERR "Input file is required.\n";
 405         exit(1);
 406     }
 407
 408     return \%opts;
 409 }
 410
 411 sub _split_tags {
 412     my $tags = shift;
 413     return [split(/\h+/, $tags || '')];
 414 }
 415
 416 1;