From: Charles McGarvey Date: Thu, 13 Jun 2019 04:55:17 +0000 (-0600) Subject: Version 0.001 X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fhomebank2ledger;a=commitdiff_plain;h=71591e40fa4a522e41ed7283cce39780f4ef8cb5 Version 0.001 --- 71591e40fa4a522e41ed7283cce39780f4ef8cb5 diff --git a/Changes b/Changes new file mode 100644 index 0000000..decc113 --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for homebank2ledger. + +0.001 2019-06-12 22:54:58-06:00 MST7MDT + * Initial early development release + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..62a1058 --- /dev/null +++ b/LICENSE @@ -0,0 +1,32 @@ +This software is Copyright (c) 2019 by Charles McGarvey. + +This is free software, licensed under: + + The MIT (X11) License + +The MIT License + +Permission is hereby granted, free of charge, to any person +obtaining a copy of this software and associated +documentation files (the "Software"), to deal in the Software +without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to +whom the Software is furnished to do so, subject to the +following conditions: + +The above copyright notice and this permission notice shall +be included in all copies or substantial portions of the +Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT +WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, +INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR +PURPOSE AND NONINFRINGEMENT. IN NO EVENT +SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..69e0884 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,30 @@ +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. +Changes +LICENSE +MANIFEST +META.json +META.yml +Makefile.PL +README +bin/homebank2ledger +lib/App/HomeBank2Ledger.pm +lib/App/HomeBank2Ledger/Formatter.pm +lib/App/HomeBank2Ledger/Formatter/Beancount.pm +lib/App/HomeBank2Ledger/Formatter/Ledger.pm +lib/App/HomeBank2Ledger/Ledger.pm +lib/App/HomeBank2Ledger/Util.pm +lib/File/HomeBank.pm +t/00-compile.t +t/00-report-prereqs.dd +t/00-report-prereqs.t +xt/author/critic.t +xt/author/eol.t +xt/author/minimum-version.t +xt/author/no-tabs.t +xt/author/pod-coverage.t +xt/author/pod-no404s.t +xt/author/pod-syntax.t +xt/author/portability.t +xt/release/consistent-version.t +xt/release/cpan-changes.t +xt/release/distmeta.t diff --git a/META.json b/META.json new file mode 100644 index 0000000..a7a8999 --- /dev/null +++ b/META.json @@ -0,0 +1,131 @@ +{ + "abstract" : "A tool to convert HomeBank files to Ledger format", + "author" : [ + "Charles McGarvey " + ], + "dynamic_config" : 0, + "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", + "license" : [ + "mit" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "homebank2ledger", + "no_index" : { + "directory" : [ + "eg", + "share", + "shares", + "t", + "xt" + ] + }, + "prereqs" : { + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "develop" : { + "requires" : { + "Dist::Zilla" : "5", + "Dist::Zilla::Plugin::ConsistentVersionTest" : "0", + "Dist::Zilla::PluginBundle::Author::CCM" : "0", + "Dist::Zilla::PluginBundle::Filter" : "0", + "Pod::Coverage::TrustPod" : "0", + "Software::License::MIT" : "0", + "Test::CPAN::Changes" : "0.19", + "Test::CPAN::Meta" : "0", + "Test::ConsistentVersion" : "0", + "Test::EOL" : "0", + "Test::MinimumVersion" : "0", + "Test::More" : "0.96", + "Test::NoTabs" : "0", + "Test::Perl::Critic" : "0", + "Test::Pod" : "1.41", + "Test::Pod::Coverage" : "1.08", + "Test::Pod::No404s" : "0", + "Test::Portability::Files" : "0" + } + }, + "runtime" : { + "requires" : { + "Carp" : "0", + "Exporter" : "0", + "Getopt::Long" : "2.38", + "Module::Load" : "0", + "Module::Pluggable" : "0", + "Pod::Usage" : "0", + "Scalar::Util" : "0", + "Time::Piece" : "0", + "XML::Entities" : "0", + "XML::Parser::Lite" : "0", + "parent" : "0", + "strict" : "0", + "warnings" : "0" + } + }, + "test" : { + "recommends" : { + "CPAN::Meta" : "2.120900" + }, + "requires" : { + "ExtUtils::MakeMaker" : "0", + "File::Spec" : "0", + "IO::Handle" : "0", + "IPC::Open3" : "0", + "Test::More" : "0", + "perl" : "5.006" + } + } + }, + "provides" : { + "App::HomeBank2Ledger" : { + "file" : "lib/App/HomeBank2Ledger.pm", + "version" : "0.001" + }, + "App::HomeBank2Ledger::Formatter" : { + "file" : "lib/App/HomeBank2Ledger/Formatter.pm", + "version" : "0.001" + }, + "App::HomeBank2Ledger::Formatter::Beancount" : { + "file" : "lib/App/HomeBank2Ledger/Formatter/Beancount.pm", + "version" : "0.001" + }, + "App::HomeBank2Ledger::Formatter::Ledger" : { + "file" : "lib/App/HomeBank2Ledger/Formatter/Ledger.pm", + "version" : "0.001" + }, + "App::HomeBank2Ledger::Ledger" : { + "file" : "lib/App/HomeBank2Ledger/Ledger.pm", + "version" : "0.001" + }, + "App::HomeBank2Ledger::Util" : { + "file" : "lib/App/HomeBank2Ledger/Util.pm", + "version" : "0.001" + }, + "File::HomeBank" : { + "file" : "lib/File/HomeBank.pm", + "version" : "0.001" + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "https://github.com/chazmcgarvey/homebank2ledger/issues" + }, + "homepage" : "https://github.com/chazmcgarvey/homebank2ledger", + "repository" : { + "type" : "git", + "url" : "https://github.com/chazmcgarvey/homebank2ledger.git", + "web" : "https://github.com/chazmcgarvey/homebank2ledger" + } + }, + "version" : "0.001", + "x_authority" : "cpan:CCM", + "x_generated_by_perl" : "v5.28.0", + "x_serialization_backend" : "Cpanel::JSON::XS version 4.08" +} + diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..ca2694c --- /dev/null +++ b/META.yml @@ -0,0 +1,71 @@ +--- +abstract: 'A tool to convert HomeBank files to Ledger format' +author: + - 'Charles McGarvey ' +build_requires: + ExtUtils::MakeMaker: '0' + File::Spec: '0' + IO::Handle: '0' + IPC::Open3: '0' + Test::More: '0' + perl: '5.006' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 0 +generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' +license: mit +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: homebank2ledger +no_index: + directory: + - eg + - share + - shares + - t + - xt +provides: + App::HomeBank2Ledger: + file: lib/App/HomeBank2Ledger.pm + version: '0.001' + App::HomeBank2Ledger::Formatter: + file: lib/App/HomeBank2Ledger/Formatter.pm + version: '0.001' + App::HomeBank2Ledger::Formatter::Beancount: + file: lib/App/HomeBank2Ledger/Formatter/Beancount.pm + version: '0.001' + App::HomeBank2Ledger::Formatter::Ledger: + file: lib/App/HomeBank2Ledger/Formatter/Ledger.pm + version: '0.001' + App::HomeBank2Ledger::Ledger: + file: lib/App/HomeBank2Ledger/Ledger.pm + version: '0.001' + App::HomeBank2Ledger::Util: + file: lib/App/HomeBank2Ledger/Util.pm + version: '0.001' + File::HomeBank: + file: lib/File/HomeBank.pm + version: '0.001' +requires: + Carp: '0' + Exporter: '0' + Getopt::Long: '2.38' + Module::Load: '0' + Module::Pluggable: '0' + Pod::Usage: '0' + Scalar::Util: '0' + Time::Piece: '0' + XML::Entities: '0' + XML::Parser::Lite: '0' + parent: '0' + strict: '0' + warnings: '0' +resources: + bugtracker: https://github.com/chazmcgarvey/homebank2ledger/issues + homepage: https://github.com/chazmcgarvey/homebank2ledger + repository: https://github.com/chazmcgarvey/homebank2ledger.git +version: '0.001' +x_authority: cpan:CCM +x_generated_by_perl: v5.28.0 +x_serialization_backend: 'YAML::Tiny version 1.73' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..407f870 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,82 @@ +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. +use strict; +use warnings; + +use 5.006; + +use ExtUtils::MakeMaker; + +my %WriteMakefileArgs = ( + "ABSTRACT" => "A tool to convert HomeBank files to Ledger format", + "AUTHOR" => "Charles McGarvey ", + "CONFIGURE_REQUIRES" => { + "ExtUtils::MakeMaker" => 0 + }, + "DISTNAME" => "homebank2ledger", + "EXE_FILES" => [ + "bin/homebank2ledger" + ], + "LICENSE" => "mit", + "MIN_PERL_VERSION" => "5.006", + "NAME" => "homebank2ledger", + "PREREQ_PM" => { + "Carp" => 0, + "Exporter" => 0, + "Getopt::Long" => "2.38", + "Module::Load" => 0, + "Module::Pluggable" => 0, + "Pod::Usage" => 0, + "Scalar::Util" => 0, + "Time::Piece" => 0, + "XML::Entities" => 0, + "XML::Parser::Lite" => 0, + "parent" => 0, + "strict" => 0, + "warnings" => 0 + }, + "TEST_REQUIRES" => { + "ExtUtils::MakeMaker" => 0, + "File::Spec" => 0, + "IO::Handle" => 0, + "IPC::Open3" => 0, + "Test::More" => 0 + }, + "VERSION" => "0.001", + "test" => { + "TESTS" => "t/*.t" + } +); + + +my %FallbackPrereqs = ( + "Carp" => 0, + "Exporter" => 0, + "ExtUtils::MakeMaker" => 0, + "File::Spec" => 0, + "Getopt::Long" => "2.38", + "IO::Handle" => 0, + "IPC::Open3" => 0, + "Module::Load" => 0, + "Module::Pluggable" => 0, + "Pod::Usage" => 0, + "Scalar::Util" => 0, + "Test::More" => 0, + "Time::Piece" => 0, + "XML::Entities" => 0, + "XML::Parser::Lite" => 0, + "parent" => 0, + "strict" => 0, + "warnings" => 0 +); + + +unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { + delete $WriteMakefileArgs{TEST_REQUIRES}; + delete $WriteMakefileArgs{BUILD_REQUIRES}; + $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; +} + +delete $WriteMakefileArgs{CONFIGURE_REQUIRES} + unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; + +WriteMakefile(%WriteMakefileArgs); diff --git a/README b/README new file mode 100644 index 0000000..edf80f6 --- /dev/null +++ b/README @@ -0,0 +1,70 @@ +NAME + + App::HomeBank2Ledger - A tool to convert HomeBank files to Ledger + format + +VERSION + + version 0.001 + +SYNOPSIS + + App::HomeBank2Ledger->main(@args); + +DESCRIPTION + + This module is part of the homebank2ledger script. + +METHODS + + main + + App::HomeBank2Ledger->main(@args); + + Run the script and exit; does not return. + + formatter + + $formatter = $app->formatter($homebank, $opts); + + Generate a App::HomeBank2Ledger::Formatter. + + convert_homebank_to_ledger + + my $ledger = $app->convert_homebank_to_ledger($homebank, $opts); + + Converts a File::HomeBank to a App::HomeBank2Ledger::Ledger. + + print_to_file + + $app->print_to_file($str); + $app->print_to_file($str, $filepath); + + Print a string to a file (or STDOUT). + + parse_args + + $opts = $app->parse_args(@args); + + Parse command-line arguments. + +BUGS + + Please report any bugs or feature requests on the bugtracker website + https://github.com/chazmcgarvey/homebank2ledger/issues + + When submitting a bug or request, please include a test-file or a patch + to an existing test-file that illustrates the bug or desired feature. + +AUTHOR + + Charles McGarvey + +COPYRIGHT AND LICENSE + + This software is Copyright (c) 2019 by Charles McGarvey. + + This is free software, licensed under: + + The MIT (X11) License + diff --git a/bin/homebank2ledger b/bin/homebank2ledger new file mode 100644 index 0000000..2e398b5 --- /dev/null +++ b/bin/homebank2ledger @@ -0,0 +1,304 @@ +#! perl +# ABSTRACT: A tool to convert HomeBank files to Ledger format +# PODNAME: homebank2ledger + + +use warnings; +use strict; + +use App::HomeBank2Ledger; + +our $VERSION = '0.001'; # VERSION + +App::HomeBank2Ledger->main(@ARGV); + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +homebank2ledger - A tool to convert HomeBank files to Ledger format + +=head1 VERSION + +version 0.001 + +=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 converts L files to a format usable by +L. It can also convert directly to the similar +L format. + +This software is B, in early development. Its interface may change without notice. + +I wrote C because I have been maintaining my own personal finances using HomeBank +(which is awesome) and I wanted to investigate using plain text accounting programs. 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 + +=over 4 + +=item * + +Converts HomeBank accounts and categories into a typical set of double-entry accounts. + +=item * + +Retains HomeBank metadata, including payees and tags. + +=item * + +Offers some customization of the output ledger, like account renaming. + +=back + +This program is feature-complete in my opinion (well, almost -- see L), but if there is +anything you think it 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. + +Alias: C<-o> + +=head2 --format STR + +Specify the output file format. If provided, must be one of: + +=over 4 + +=item * + +ledger + +=item * + +beancount + +=back + +=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 tries to come +up with sensible account names (based on your HomeBank accounts and categories) that fit into five +root accounts: + +=over 4 + +=item * + +Assets + +=item * + +Liabilities + +=item * + +Equity + +=item * + +Income + +=item * + +Expenses + +=back + +The value of the argument must be of the form "REGEXP=REPLACEMENT". See L. + +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 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 + +=head1 CAVEATS + +=over 4 + +=item * + +I didn't intend to make this a releasable robust product, so it's lacking tests. + +=item * + +Budgets and scheduled transactions are not (yet) converted. + +=item * + +There are some minor formatting tweaks I will make (e.g. consolidate transaction tags and payees) + +=back + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +L + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=head1 AUTHOR + +Charles McGarvey + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2019 by Charles McGarvey. + +This is free software, licensed under: + + The MIT (X11) License + +=cut diff --git a/lib/App/HomeBank2Ledger.pm b/lib/App/HomeBank2Ledger.pm new file mode 100644 index 0000000..13cb9d2 --- /dev/null +++ b/lib/App/HomeBank2Ledger.pm @@ -0,0 +1,449 @@ +package App::HomeBank2Ledger; +# ABSTRACT: A tool to convert HomeBank files to Ledger format + + +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 = '0.001'; # 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'; + + +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; +} + + +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, + ); +} + + +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 oldest + 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 => $memo, + 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->{name}, + memo => $memo, + postings => \@postings, + }); + } + + return $ledger; +} + + +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; +} + + +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; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +App::HomeBank2Ledger - A tool to convert HomeBank files to Ledger format + +=head1 VERSION + +version 0.001 + +=head1 SYNOPSIS + + App::HomeBank2Ledger->main(@args); + +=head1 DESCRIPTION + +This module is part of the L script. + +=head1 METHODS + +=head2 main + + App::HomeBank2Ledger->main(@args); + +Run the script and exit; does not return. + +=head2 formatter + + $formatter = $app->formatter($homebank, $opts); + +Generate a L. + +=head2 convert_homebank_to_ledger + + my $ledger = $app->convert_homebank_to_ledger($homebank, $opts); + +Converts a L to a L. + +=head2 print_to_file + + $app->print_to_file($str); + $app->print_to_file($str, $filepath); + +Print a string to a file (or STDOUT). + +=head2 parse_args + + $opts = $app->parse_args(@args); + +Parse command-line arguments. + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +L + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=head1 AUTHOR + +Charles McGarvey + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2019 by Charles McGarvey. + +This is free software, licensed under: + + The MIT (X11) License + +=cut diff --git a/lib/App/HomeBank2Ledger/Formatter.pm b/lib/App/HomeBank2Ledger/Formatter.pm new file mode 100644 index 0000000..3113ecb --- /dev/null +++ b/lib/App/HomeBank2Ledger/Formatter.pm @@ -0,0 +1,144 @@ +package App::HomeBank2Ledger::Formatter; +# ABSTRACT: Abstract class for formatting a ledger + + +use warnings; +use strict; + +use Module::Load; +use Module::Pluggable search_path => [__PACKAGE__], + sub_name => 'available_formatters'; + +our $VERSION = '0.001'; # VERSION + +sub _croak { require Carp; Carp::croak(@_) } + + +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; +} + + +sub format { + ... +} + + +sub type { shift->{type} } +sub name { shift->{name} } +sub file { shift->{file} } +sub account_width { shift->{account_width} || 40 } + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +App::HomeBank2Ledger::Formatter - Abstract class for formatting a ledger + +=head1 VERSION + +version 0.001 + +=head1 SYNOPSIS + + my $formatter = App::HomeBank2Ledger::Formatter->new( + type => 'ledger', + ); + print $formatter->format($ledger); + +=head1 DESCRIPTION + +This class formats L as for a file. + +=head1 ATTRIBUTES + +=head2 type + +Get the type of formatter. + +=head2 name + +Get the name or title of the ledger. + +=head2 file + +Get the filepath where the ledger data came from. + +=head2 account_width + +Get the number of characters to use for the account column. + +=head1 METHODS + +=head2 new + + $formatter = App::HomeBank2Ledger::Formatter->new(type => $format); + +Construct a new formatter object. + +=head2 format + + $str = $formatter->format($ledger); + +Do the actual formatting of ledger data into a serialized form. + +This must be overridden by subclasses. + +=head1 SEE ALSO + +=over 4 + +=item * + +L + +=item * + +L + +=back + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +L + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=head1 AUTHOR + +Charles McGarvey + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2019 by Charles McGarvey. + +This is free software, licensed under: + + The MIT (X11) License + +=cut diff --git a/lib/App/HomeBank2Ledger/Formatter/Beancount.pm b/lib/App/HomeBank2Ledger/Formatter/Beancount.pm new file mode 100644 index 0000000..515e5ec --- /dev/null +++ b/lib/App/HomeBank2Ledger/Formatter/Beancount.pm @@ -0,0 +1,291 @@ +package App::HomeBank2Ledger::Formatter::Beancount; +# ABSTRACT: Beancount formatter + + +use warnings; +use strict; + +use App::HomeBank2Ledger::Util qw(commify rtrim); + +use parent 'App::HomeBank2Ledger::Formatter'; + +our $VERSION = '0.001'; # VERSION + +my %STATUS_SYMBOLS = ( + cleared => '*', + pending => '!', +); +my $UNKNOWN_DATE = '0001-01-01'; + +sub _croak { require Carp; Carp::croak(@_) } + +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($/, map { rtrim($_) } @out); +} + +sub _format_header { + my $self = shift; + + my @out; + + if (my $name = $self->name) { + push @out, "; Name: $name"; + } + + my $file = $self->file; + push @out, "; Converted from ${file} using homebank2ledger ${VERSION}"; + + push @out, ''; + + return @out; +} + +sub _format_accounts { + my $self = shift; + my $ledger = shift; + + my @out; + + for my $account (sort @{$ledger->accounts}) { + my $oldest_transaction = $self->_find_oldest_transaction_by_account($account, $ledger); + my $account_date = $oldest_transaction->{date} || $UNKNOWN_DATE; + $account = $self->_format_account($account); + + push @out, "${account_date} open ${account}"; + } + push @out, ''; + + return @out; +} + +sub _format_commodities { + my $self = shift; + my $ledger = shift; + + my @out; + + for my $commodity (@{$ledger->commodities}) { + my $oldest_transaction = $self->_find_oldest_transaction_by_commodity($commodity, $ledger); + my $commodity_date = $oldest_transaction->{date} || $UNKNOWN_DATE; + + push @out, "${commodity_date} commodity $commodity->{iso}"; + push @out, ' name: '.$self->_format_string($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} || ''; + 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'} || ''; + } + } + + push @out, sprintf('%s%s%s%s', $date, + $status_symbol && ' '.$status_symbol || ' *', # status (or "txn") is required + ($payee || $memo) && ' '.$self->_format_string($payee), + $memo && ' '.$self->_format_string($memo), + ); + + 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->_format_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); + } + + push @out, ''; + + return @out; +} + +sub _format_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; +} + +sub _format_string { + my $self = shift; + my $str = shift; + $str =~ s/"/\\"/g; + return "\"$str\""; +} + +sub _format_amount { + my $self = shift; + my $amount = shift; + my $commodity = shift or _croak 'Must provide a valid currency'; + + 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 _find_oldest_transaction_by_account { + my $self = shift; + my $account = shift; + my $ledger = shift; + + $account = $self->_format_account($account); + + my $oldest = $self->{oldest_transaction_by_account}; + if (!$oldest) { + # build index + for my $transaction (@{$ledger->transactions}) { + for my $posting (@{$transaction->{postings}}) { + my $account = $self->_format_account($posting->{account}); + + if ($transaction->{date} lt ($oldest->{$account}{date} || '9999-99-99')) { + $oldest->{$account} = $transaction; + } + } + } + + $self->{oldest_transaction_by_account} = $oldest; + } + + return $oldest->{$account}; +} + +sub _find_oldest_transaction_by_commodity { + my $self = shift; + my $commodity = shift; + my $ledger = shift; + + my $oldest = $self->{oldest_transaction_by_commodity}; + if (!$oldest) { + # build index + for my $transaction (@{$ledger->transactions}) { + for my $posting (@{$transaction->{postings}}) { + my $symbol = $posting->{commodity}{symbol}; + next if !$symbol; + + if ($transaction->{date} lt ($oldest->{$symbol}{date} || '9999-99-99')) { + $oldest->{$symbol} = $transaction; + } + } + } + + $self->{oldest_transaction_by_commodity} = $oldest; + } + + return $oldest->{$commodity->{symbol}}; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +App::HomeBank2Ledger::Formatter::Beancount - Beancount formatter + +=head1 VERSION + +version 0.001 + +=head1 DESCRIPTION + +This is a formatter for L. + +=head1 SEE ALSO + +L + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +L + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=head1 AUTHOR + +Charles McGarvey + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2019 by Charles McGarvey. + +This is free software, licensed under: + + The MIT (X11) License + +=cut diff --git a/lib/App/HomeBank2Ledger/Formatter/Ledger.pm b/lib/App/HomeBank2Ledger/Formatter/Ledger.pm new file mode 100644 index 0000000..8fba2a3 --- /dev/null +++ b/lib/App/HomeBank2Ledger/Formatter/Ledger.pm @@ -0,0 +1,249 @@ +package App::HomeBank2Ledger::Formatter::Ledger; +# ABSTRACT: Ledger formatter + + +use warnings; +use strict; + +use App::HomeBank2Ledger::Util qw(commify rtrim); + +use parent 'App::HomeBank2Ledger::Formatter'; + +our $VERSION = '0.001'; # VERSION + +my %STATUS_SYMBOLS = ( + cleared => '*', + pending => '!', +); + +sub _croak { require Carp; Carp::croak(@_) } + +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($/, map { rtrim($_) } @out); +} + +sub _format_header { + my $self = shift; + + my @out; + + if (my $name = $self->name) { + push @out, "; Name: $name"; + } + + my $file = $self->file; + push @out, "; Converted from ${file} using homebank2ledger ${VERSION}"; + + 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 = $self->_format_string($transaction->{payee} || ''); + my $memo = $self->_format_string($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'} || ''; + } + } + + $payee =~ s/(?: )|\t;/ ;/g; # don't turn into a memo + + push @out, sprintf('%s%s%s%s', $date, + $status_symbol && " ${status_symbol}", + $payee && " $payee", + $memo && " ; $memo", + ); + + 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); + + if (my $payee = $posting->{payee}) { + push @out, ' ; Payee: '.$self->_format_string($payee); + } + + if (my @tags = @{$posting->{tags} || []}) { + push @out, " ; :".join(':', @tags).":"; + } + } + + push @out, ''; + + return @out; +} + +sub _format_string { + my $self = shift; + my $str = shift; + $str =~ s/\v//g; + return $str; +} + +sub _format_amount { + my $self = shift; + my $amount = shift; + my $commodity = shift or _croak 'Must provide a valid currency'; + + 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; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +App::HomeBank2Ledger::Formatter::Ledger - Ledger formatter + +=head1 VERSION + +version 0.001 + +=head1 DESCRIPTION + +This is a formatter for L. + +=head1 SEE ALSO + +L + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +L + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=head1 AUTHOR + +Charles McGarvey + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2019 by Charles McGarvey. + +This is free software, licensed under: + + The MIT (X11) License + +=cut diff --git a/lib/App/HomeBank2Ledger/Ledger.pm b/lib/App/HomeBank2Ledger/Ledger.pm new file mode 100644 index 0000000..18522cb --- /dev/null +++ b/lib/App/HomeBank2Ledger/Ledger.pm @@ -0,0 +1,215 @@ +package App::HomeBank2Ledger::Ledger; +# ABSTRACT: Ledger data representation + + +use warnings; +use strict; + +our $VERSION = '0.001'; # VERSION + + +sub new { + my $class = shift; + my %args = @_; + return bless {%args}, $class; +} + + +sub accounts { shift->{accounts} || [] } +sub commodities { shift->{commodities} || [] } +sub payees { shift->{payees} || [] } +sub tags { shift->{tags} || [] } +sub transactions { shift->{transactions} || [] } + + +# 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; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +App::HomeBank2Ledger::Ledger - Ledger data representation + +=head1 VERSION + +version 0.001 + +=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: + +=head1 ATTRIBUTES + +=head2 accounts + +Get an arrayref of accounts. + +=head2 commodities + +Get an arrayref of commodities. + +=head2 payees + +Get an arrayref of payees. + +=head2 tags + +Get an arrayref of tags. + +=head2 transactions + +Get an arrayref of transactions. + +=head1 METHODS + +=head2 new + + $ledger = App::HomeBank2Ledger::Ledger->new(%ledger_data); + +Construct a new ledger instance. + +=head2 add_accounts + +Add accounts. + +=head2 add_commodities + +Add commodities. + +=head2 add_payees + +Add payees. + +=head2 add_tags + +Add tags. + +=head2 add_transactions + +Add transactions. + +=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)], + }, + ... + ], + } + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +L + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=head1 AUTHOR + +Charles McGarvey + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2019 by Charles McGarvey. + +This is free software, licensed under: + + The MIT (X11) License + +=cut diff --git a/lib/App/HomeBank2Ledger/Util.pm b/lib/App/HomeBank2Ledger/Util.pm new file mode 100644 index 0000000..58bc80f --- /dev/null +++ b/lib/App/HomeBank2Ledger/Util.pm @@ -0,0 +1,83 @@ +package App::HomeBank2Ledger::Util; +# ABSTRACT: Miscellaneous utility functions + +use warnings; +use strict; + +use Exporter qw(import); + +our $VERSION = '0.001'; # VERSION + +our @EXPORT_OK = qw(commify rtrim); + + +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; +} + + +sub rtrim { + my $str = shift; + $str =~ s/\h+$//; + return $str; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +App::HomeBank2Ledger::Util - Miscellaneous utility functions + +=head1 VERSION + +version 0.001 + +=head1 FUNCTIONS + +=head2 commify + + $commified = commify($num); + $commified = commify($num, $comma_char); + +Just another commify subroutine. + +=head2 rtrim + + $trimmed_str = rtrim($str); + +Right-trim a string. + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +L + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=head1 AUTHOR + +Charles McGarvey + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2019 by Charles McGarvey. + +This is free software, licensed under: + + The MIT (X11) License + +=cut diff --git a/lib/File/HomeBank.pm b/lib/File/HomeBank.pm new file mode 100644 index 0000000..2c0a2d3 --- /dev/null +++ b/lib/File/HomeBank.pm @@ -0,0 +1,666 @@ +package File::HomeBank; +# ABSTRACT: Parse HomeBank files + + +use warnings; +use strict; + +use App::HomeBank2Ledger::Util qw(commify); +use Exporter qw(import); +use Scalar::Util qw(refaddr); +use Time::Piece; +use XML::Entities; +use XML::Parser::Lite; + +our $VERSION = '0.001'; # VERSION + +our @EXPORT_OK = qw(parse_string parse_file); + +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', +); + +sub _croak { require Carp; Carp::croak(@_) } +sub _usage { _croak("Usage: @_\n") } + + +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; +} + + +sub file { + shift->{file}; +} + + +sub title { + shift->{properties}{title}; +} + + +sub base_currency { + shift->{properties}{currency}; +} + + +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]; +} + + +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}; +} + + +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}; +} + + +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}; +} + + +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}; +} + + +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} || []}; +} + + +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; + } +} + + +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; +} + + +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); +} + + +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; +} + + +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); +} + + +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 = @_; + + # decode all attribute values + for my $key (keys %attr) { + $attr{$key} = _decode_xml_entities($attr{$key}); + } + + 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 _decode_xml_entities { + my $str = shift; + # decoding entities can be extremely slow, so don't bother if it doesn't look like there are any + # entities to decode + return $str if $str !~ /&(?:#\d+)|[A-Za-z0-9]+;/; + return XML::Entities::decode('all', $str); +} + +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; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +File::HomeBank - Parse HomeBank files + +=head1 VERSION + +version 0.001 + +=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 files. + +=head1 ATTRIBUTES + +=head2 file + +Get the filepath (if parsed from a file). + +=head1 METHODS + +=head2 new + + $homebank = File::HomeBank->new(string => $str); + $homebank = File::HomeBank->new(file => $filepath); + +Construct a L. + +=head2 title + + $title = $homebank->title; + +Get the title or owner property. + +=head2 base_currency + + $base_currency = $homebank->base_currency; + +Get the key of the base currency. + +=head2 accounts + +Get an arrayref of accounts. + +=head2 categories + +Get an arrayref of categories. + +=head2 currencies + +Get an arrayref of currencies. + +=head2 payees + +Get an arrayref of payees. + +=head2 tags + +Get an arrayref of tags. + +=head2 transactions + +Get an arrayref of transactions. + +=head2 find_account_by_key + + $account = $homebank->find_account_by_key($key); + +Find a account with the given key. + +=head2 find_currency_by_key + + $currency = $homebank->find_currency_by_key($key); + +Find a currency with the given key. + +=head2 find_category_by_key + + $category = $homebank->find_category_by_key($key); + +Find a category with the given key. + +=head2 find_payee_by_key + + $payee = $homebank->find_payee_by_key($key); + +Find a payee with the given key. + +=head2 find_transactions_by_transfer_key + + @transactions = $homebank->find_transactions_by_transfer_key($key); + +Find all transactions that share the same transfer key. + +=head2 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. + +=head2 sorted_transactions + + $transations = $homebank->sorted_transactions; + +Get an arrayref of transactions sorted by date (oldest first). + +=head2 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" + +=head2 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. + +=head1 FUNCTIONS + +=head2 parse_file + + $homebank_data = parse_file($filepath); + +Read and parse a HomeBank .xhb file from a filesystem. + +=head2 parse_string + + $homebank_data = parse_string($str); + +Parse a HomeBank file from a string. + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +L + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=head1 AUTHOR + +Charles McGarvey + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2019 by Charles McGarvey. + +This is free software, licensed under: + + The MIT (X11) License + +=cut diff --git a/t/00-compile.t b/t/00-compile.t new file mode 100644 index 0000000..8928271 --- /dev/null +++ b/t/00-compile.t @@ -0,0 +1,103 @@ +use 5.006; +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 + +use Test::More; + +plan tests => 8 + ($ENV{AUTHOR_TESTING} ? 1 : 0); + +my @module_files = ( + 'App/HomeBank2Ledger.pm', + 'App/HomeBank2Ledger/Formatter.pm', + 'App/HomeBank2Ledger/Formatter/Beancount.pm', + 'App/HomeBank2Ledger/Formatter/Ledger.pm', + 'App/HomeBank2Ledger/Ledger.pm', + 'App/HomeBank2Ledger/Util.pm', + 'File/HomeBank.pm' +); + +my @scripts = ( + 'bin/homebank2ledger' +); + +# no fake home requested + +my @switches = ( + -d 'blib' ? '-Mblib' : '-Ilib', +); + +use File::Spec; +use IPC::Open3; +use IO::Handle; + +open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; + +my @warnings; +for my $lib (@module_files) +{ + # see L + my $stderr = IO::Handle->new; + + diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } + $^X, @switches, '-e', "require q[$lib]")) + if $ENV{PERL_COMPILE_TEST_DEBUG}; + + my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); + binmode $stderr, ':crlf' if $^O eq 'MSWin32'; + my @_warnings = <$stderr>; + waitpid($pid, 0); + is($?, 0, "$lib loaded ok"); + + shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ + and not eval { +require blib; blib->VERSION('1.01') }; + + if (@_warnings) + { + warn @_warnings; + push @warnings, @_warnings; + } +} + +foreach my $file (@scripts) +{ SKIP: { + open my $fh, '<', $file or warn("Unable to open $file: $!"), next; + my $line = <$fh>; + + close $fh and skip("$file isn't perl", 1) unless $line =~ /^#!\s*(?:\S*perl\S*)((?:\s+-\w*)*)(?:\s*#.*)?$/; + @switches = (@switches, split(' ', $1)) if $1; + + close $fh and skip("$file uses -T; not testable with PERL5LIB", 1) + if grep { $_ eq '-T' } @switches and $ENV{PERL5LIB}; + + my $stderr = IO::Handle->new; + + diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } + $^X, @switches, '-c', $file)) + if $ENV{PERL_COMPILE_TEST_DEBUG}; + + my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-c', $file); + binmode $stderr, ':crlf' if $^O eq 'MSWin32'; + my @_warnings = <$stderr>; + waitpid($pid, 0); + is($?, 0, "$file compiled ok"); + + shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ + and not eval { +require blib; blib->VERSION('1.01') }; + + # in older perls, -c output is simply the file portion of the path being tested + if (@_warnings = grep { !/\bsyntax OK$/ } + grep { chomp; $_ ne (File::Spec->splitpath($file))[2] } @_warnings) + { + warn @_warnings; + push @warnings, @_warnings; + } +} } + + + +is(scalar(@warnings), 0, 'no warnings found') + or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; + + diff --git a/t/00-report-prereqs.dd b/t/00-report-prereqs.dd new file mode 100644 index 0000000..4ce9265 --- /dev/null +++ b/t/00-report-prereqs.dd @@ -0,0 +1,61 @@ +do { my $x = { + 'configure' => { + 'requires' => { + 'ExtUtils::MakeMaker' => '0' + } + }, + 'develop' => { + 'requires' => { + 'Dist::Zilla' => '5', + 'Dist::Zilla::Plugin::ConsistentVersionTest' => '0', + 'Dist::Zilla::PluginBundle::Author::CCM' => '0', + 'Dist::Zilla::PluginBundle::Filter' => '0', + 'Pod::Coverage::TrustPod' => '0', + 'Software::License::MIT' => '0', + 'Test::CPAN::Changes' => '0.19', + 'Test::CPAN::Meta' => '0', + 'Test::ConsistentVersion' => '0', + 'Test::EOL' => '0', + 'Test::MinimumVersion' => '0', + 'Test::More' => '0.96', + 'Test::NoTabs' => '0', + 'Test::Perl::Critic' => '0', + 'Test::Pod' => '1.41', + 'Test::Pod::Coverage' => '1.08', + 'Test::Pod::No404s' => '0', + 'Test::Portability::Files' => '0' + } + }, + 'runtime' => { + 'requires' => { + 'Carp' => '0', + 'Exporter' => '0', + 'Getopt::Long' => '2.38', + 'Module::Load' => '0', + 'Module::Pluggable' => '0', + 'Pod::Usage' => '0', + 'Scalar::Util' => '0', + 'Time::Piece' => '0', + 'XML::Entities' => '0', + 'XML::Parser::Lite' => '0', + 'parent' => '0', + 'strict' => '0', + 'warnings' => '0' + } + }, + 'test' => { + 'recommends' => { + 'CPAN::Meta' => '2.120900' + }, + 'requires' => { + 'ExtUtils::MakeMaker' => '0', + 'File::Spec' => '0', + 'IO::Handle' => '0', + 'IPC::Open3' => '0', + 'Test::More' => '0', + 'perl' => '5.006' + } + } + }; + $x; + } \ No newline at end of file diff --git a/t/00-report-prereqs.t b/t/00-report-prereqs.t new file mode 100644 index 0000000..c72183a --- /dev/null +++ b/t/00-report-prereqs.t @@ -0,0 +1,193 @@ +#!perl + +use strict; +use warnings; + +# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.027 + +use Test::More tests => 1; + +use ExtUtils::MakeMaker; +use File::Spec; + +# from $version::LAX +my $lax_version_re = + qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? + | + (?:\.[0-9]+) (?:_[0-9]+)? + ) | (?: + v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? + | + (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? + ) + )/x; + +# hide optional CPAN::Meta modules from prereq scanner +# and check if they are available +my $cpan_meta = "CPAN::Meta"; +my $cpan_meta_pre = "CPAN::Meta::Prereqs"; +my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic + +# Verify requirements? +my $DO_VERIFY_PREREQS = 1; + +sub _max { + my $max = shift; + $max = ( $_ > $max ) ? $_ : $max for @_; + return $max; +} + +sub _merge_prereqs { + my ($collector, $prereqs) = @_; + + # CPAN::Meta::Prereqs object + if (ref $collector eq $cpan_meta_pre) { + return $collector->with_merged_prereqs( + CPAN::Meta::Prereqs->new( $prereqs ) + ); + } + + # Raw hashrefs + for my $phase ( keys %$prereqs ) { + for my $type ( keys %{ $prereqs->{$phase} } ) { + for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { + $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; + } + } + } + + return $collector; +} + +my @include = qw( + +); + +my @exclude = qw( + +); + +# Add static prereqs to the included modules list +my $static_prereqs = do './t/00-report-prereqs.dd'; + +# Merge all prereqs (either with ::Prereqs or a hashref) +my $full_prereqs = _merge_prereqs( + ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), + $static_prereqs +); + +# Add dynamic prereqs to the included modules list (if we can) +my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; +my $cpan_meta_error; +if ( $source && $HAS_CPAN_META + && (my $meta = eval { CPAN::Meta->load_file($source) } ) +) { + $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); +} +else { + $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) + $source = 'static metadata'; +} + +my @full_reports; +my @dep_errors; +my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; + +# Add static includes into a fake section +for my $mod (@include) { + $req_hash->{other}{modules}{$mod} = 0; +} + +for my $phase ( qw(configure build test runtime develop other) ) { + next unless $req_hash->{$phase}; + next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); + + for my $type ( qw(requires recommends suggests conflicts modules) ) { + next unless $req_hash->{$phase}{$type}; + + my $title = ucfirst($phase).' '.ucfirst($type); + my @reports = [qw/Module Want Have/]; + + for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { + next if $mod eq 'perl'; + next if grep { $_ eq $mod } @exclude; + + my $file = $mod; + $file =~ s{::}{/}g; + $file .= ".pm"; + my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; + + my $want = $req_hash->{$phase}{$type}{$mod}; + $want = "undef" unless defined $want; + $want = "any" if !$want && $want == 0; + + my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; + + if ($prefix) { + my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); + $have = "undef" unless defined $have; + push @reports, [$mod, $want, $have]; + + if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { + if ( $have !~ /\A$lax_version_re\z/ ) { + push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; + } + elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { + push @dep_errors, "$mod version '$have' is not in required range '$want'"; + } + } + } + else { + push @reports, [$mod, $want, "missing"]; + + if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { + push @dep_errors, "$mod is not installed ($req_string)"; + } + } + } + + if ( @reports ) { + push @full_reports, "=== $title ===\n\n"; + + my $ml = _max( map { length $_->[0] } @reports ); + my $wl = _max( map { length $_->[1] } @reports ); + my $hl = _max( map { length $_->[2] } @reports ); + + if ($type eq 'modules') { + splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; + push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; + } + else { + splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; + push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; + } + + push @full_reports, "\n"; + } + } +} + +if ( @full_reports ) { + diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; +} + +if ( $cpan_meta_error || @dep_errors ) { + diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; +} + +if ( $cpan_meta_error ) { + my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; + diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; +} + +if ( @dep_errors ) { + diag join("\n", + "\nThe following REQUIRED prerequisites were not satisfied:\n", + @dep_errors, + "\n" + ); +} + +pass; + +# vim: ts=4 sts=4 sw=4 et: diff --git a/xt/author/critic.t b/xt/author/critic.t new file mode 100644 index 0000000..80ccdad --- /dev/null +++ b/xt/author/critic.t @@ -0,0 +1,7 @@ +#!perl + +use strict; +use warnings; + +use Test::Perl::Critic (-profile => "perlcritic.rc") x!! -e "perlcritic.rc"; +all_critic_ok(); diff --git a/xt/author/eol.t b/xt/author/eol.t new file mode 100644 index 0000000..4aadb99 --- /dev/null +++ b/xt/author/eol.t @@ -0,0 +1,35 @@ +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::EOL 0.19 + +use Test::More 0.88; +use Test::EOL; + +my @files = ( + 'bin/homebank2ledger', + 'lib/App/HomeBank2Ledger.pm', + 'lib/App/HomeBank2Ledger/Formatter.pm', + 'lib/App/HomeBank2Ledger/Formatter/Beancount.pm', + 'lib/App/HomeBank2Ledger/Formatter/Ledger.pm', + 'lib/App/HomeBank2Ledger/Ledger.pm', + 'lib/App/HomeBank2Ledger/Util.pm', + 'lib/File/HomeBank.pm', + 't/00-compile.t', + 't/00-report-prereqs.dd', + 't/00-report-prereqs.t', + 'xt/author/critic.t', + 'xt/author/eol.t', + 'xt/author/minimum-version.t', + 'xt/author/no-tabs.t', + 'xt/author/pod-coverage.t', + 'xt/author/pod-no404s.t', + 'xt/author/pod-syntax.t', + 'xt/author/portability.t', + 'xt/release/consistent-version.t', + 'xt/release/cpan-changes.t', + 'xt/release/distmeta.t' +); + +eol_unix_ok($_, { trailing_whitespace => 1 }) foreach @files; +done_testing; diff --git a/xt/author/minimum-version.t b/xt/author/minimum-version.t new file mode 100644 index 0000000..f61a345 --- /dev/null +++ b/xt/author/minimum-version.t @@ -0,0 +1,6 @@ +use strict; +use warnings; + +use Test::More; +use Test::MinimumVersion; +all_minimum_version_ok( qq{5.14} ); diff --git a/xt/author/no-tabs.t b/xt/author/no-tabs.t new file mode 100644 index 0000000..591a0dc --- /dev/null +++ b/xt/author/no-tabs.t @@ -0,0 +1,35 @@ +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::NoTabs 0.15 + +use Test::More 0.88; +use Test::NoTabs; + +my @files = ( + 'bin/homebank2ledger', + 'lib/App/HomeBank2Ledger.pm', + 'lib/App/HomeBank2Ledger/Formatter.pm', + 'lib/App/HomeBank2Ledger/Formatter/Beancount.pm', + 'lib/App/HomeBank2Ledger/Formatter/Ledger.pm', + 'lib/App/HomeBank2Ledger/Ledger.pm', + 'lib/App/HomeBank2Ledger/Util.pm', + 'lib/File/HomeBank.pm', + 't/00-compile.t', + 't/00-report-prereqs.dd', + 't/00-report-prereqs.t', + 'xt/author/critic.t', + 'xt/author/eol.t', + 'xt/author/minimum-version.t', + 'xt/author/no-tabs.t', + 'xt/author/pod-coverage.t', + 'xt/author/pod-no404s.t', + 'xt/author/pod-syntax.t', + 'xt/author/portability.t', + 'xt/release/consistent-version.t', + 'xt/release/cpan-changes.t', + 'xt/release/distmeta.t' +); + +notabs_ok($_) foreach @files; +done_testing; diff --git a/xt/author/pod-coverage.t b/xt/author/pod-coverage.t new file mode 100644 index 0000000..66b3b64 --- /dev/null +++ b/xt/author/pod-coverage.t @@ -0,0 +1,7 @@ +#!perl +# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. + +use Test::Pod::Coverage 1.08; +use Pod::Coverage::TrustPod; + +all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); diff --git a/xt/author/pod-no404s.t b/xt/author/pod-no404s.t new file mode 100644 index 0000000..eb9760c --- /dev/null +++ b/xt/author/pod-no404s.t @@ -0,0 +1,21 @@ +#!perl + +use strict; +use warnings; +use Test::More; + +foreach my $env_skip ( qw( + SKIP_POD_NO404S + AUTOMATED_TESTING +) ){ + plan skip_all => "\$ENV{$env_skip} is set, skipping" + if $ENV{$env_skip}; +} + +eval "use Test::Pod::No404s"; +if ( $@ ) { + plan skip_all => 'Test::Pod::No404s required for testing POD'; +} +else { + all_pod_files_ok(); +} diff --git a/xt/author/pod-syntax.t b/xt/author/pod-syntax.t new file mode 100644 index 0000000..e563e5d --- /dev/null +++ b/xt/author/pod-syntax.t @@ -0,0 +1,7 @@ +#!perl +# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. +use strict; use warnings; +use Test::More; +use Test::Pod 1.41; + +all_pod_files_ok(); diff --git a/xt/author/portability.t b/xt/author/portability.t new file mode 100644 index 0000000..c531252 --- /dev/null +++ b/xt/author/portability.t @@ -0,0 +1,10 @@ +use strict; +use warnings; + +use Test::More; + +eval 'use Test::Portability::Files'; +plan skip_all => 'Test::Portability::Files required for testing portability' + if $@; + +run_tests(); diff --git a/xt/release/consistent-version.t b/xt/release/consistent-version.t new file mode 100644 index 0000000..7f200c5 --- /dev/null +++ b/xt/release/consistent-version.t @@ -0,0 +1,10 @@ +use strict; +use warnings; + +use Test::More; + +eval "use Test::ConsistentVersion"; +plan skip_all => "Test::ConsistentVersion required for this test" + if $@; + +Test::ConsistentVersion::check_consistent_versions(); diff --git a/xt/release/cpan-changes.t b/xt/release/cpan-changes.t new file mode 100644 index 0000000..286005a --- /dev/null +++ b/xt/release/cpan-changes.t @@ -0,0 +1,10 @@ +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::CPAN::Changes 0.012 + +use Test::More 0.96 tests => 1; +use Test::CPAN::Changes; +subtest 'changes_ok' => sub { + changes_file_ok('Changes'); +}; diff --git a/xt/release/distmeta.t b/xt/release/distmeta.t new file mode 100644 index 0000000..c2280dc --- /dev/null +++ b/xt/release/distmeta.t @@ -0,0 +1,6 @@ +#!perl +# This file was automatically generated by Dist::Zilla::Plugin::MetaTests. + +use Test::CPAN::Meta; + +meta_yaml_ok();