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