#!/usr/bin/perl
#see COPYRIGHT below...
use strict;
use warnings;
use XML::LibXML;
use Data::Dumper;
use Getopt::Long;
use Pod::Usage;

=head1 NAME

gc_move_splits.pl

=head1 COPYRIGHT

Copyright (C) 2016 Lincoln A Baxter
  
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation, either version 3 of the License, or (at your
option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

Please see the GNU General Public License at L<http://www.gnu.org/licenses/>

=head1 ABSTRACT
 
Move transaction splits from one account in the GC file to
another. Useful if you have consolidated accounts, and then
discovered you want to separate out some of the transactions
into different accounts.

=cut



#global variables
my $pathSeparator = ":" ; #use the --pathSeparator switch to change
my $helptext = "";
my $verbose = 0;
my $xmlDoc = undef; 
#file handles
my $outputFN = undef;
my $outputFH = undef;
my $dumpFN   = '';
my $dumpFH   = undef;

#global hash references...
my $pathHR = {}; #for looking up by the full account path
my $accountGuidHR = {}; #map guid to name


sub BuildAccountsHierarchy
{
   my ( $account ) = @_;
   my $xpath = "/gnc-v2/gnc:book/gnc:account" ;
   my $exp = XML::LibXML::XPathExpression->new( $xpath );
   print STDOUT "findnodes after " .__LINE__ ."\n" if $verbose >= 2;
   my @nodelist = $xmlDoc->findnodes($exp);
   my $numnodes = @nodelist;
   if ( $numnodes > 0 )
   {
      print STDOUT "There are $numnodes accounts in this file\n";
      my $cnt = 0;
      foreach my $acct ( @nodelist ) 
      {
         $cnt++;
         print STDOUT "findnodes after " .__LINE__ ."\n" if $verbose >= 2;
         my ( $nameNode ) = $acct->findnodes( 'act:name' );
         my $name = $nameNode->textContent();

         print STDOUT "findnodes after " .__LINE__ ."\n" if $verbose >= 2;
         my ( $guidNode ) = $acct->findnodes( 'act:id' );
         my $guid = $guidNode->textContent();
         
         $accountGuidHR->{$guid}->{node} = $acct;
         $accountGuidHR->{$guid}->{name} = $name;

         print STDOUT "findnodes after " .__LINE__ ."\n" if $verbose >= 2;
         my ( $parentNode ) = $acct->findnodes( 'act:parent' );
         if ( $parentNode )
         {
            my $parentguid = $parentNode->textContent();
         #   print STDOUT "act parent guid: " .$parentguid ."\n" ;
            $accountGuidHR->{$guid}->{parent} = $parentguid;
         }
         #last if $cnt > 5;
      }
   } 
   #now add the account path to each HR
   foreach my $guid ( keys %$accountGuidHR ) 
   {
      #recursively get the parent name path
      my $actpath = AccountPath( $guid );
      $pathHR->{$actpath} = $guid;
      $accountGuidHR->{$guid}->{path} = $actpath;
   }
   if ( defined $dumpFH )
   {
      print $dumpFH "Guid,Account Path\n" ; 
      foreach my $key ( sort keys( %$pathHR )) {
         print $dumpFH $pathHR->{$key} .",\"$key\"\n" ;
         #print $dumpFH Dumper( $pathHR );
      }
      close $dumpFH;
      exit;
   }
   #print Dumper( $accountGuidHR );
}

#recursively build full paths for an account starting with the account's guid
#currently import-map-bayes slots reference accounts by their
#full name path (not including the Root Account.  They should
#really reference accounts by the account guid. Then import-map-bayes
#data would still be valid for renamed accounts
#deleted accounts would still need pruning however.
sub AccountPath 
{
   my ( $guid ) = @_;
   my $name = $accountGuidHR->{$guid}->{name};
   my $path = $name;
   if ( defined $accountGuidHR->{$guid}->{parent} )
   {
      my $parent = $accountGuidHR->{$guid}->{parent};
      if ( $accountGuidHR->{$parent}->{name} ne "Root Account" )
      {
         $path = AccountPath( $parent ) . $pathSeparator . $name;  
      }
   }
   return $path;
}

#required arguements:
my @descREList   = ();
my $fromAcctName = '';
my $toAcctName   = '';

my $fromAcctGuid = '';
my $toAcctGuid   = '';

sub AccountGuidFromPath
{
   my ( $path ) = @_;
   if ( not exists $pathHR->{$path} ) {
      die "account path: $path not found in this GnuCash file\n" ;
   }
   return $pathHR->{$path};
}

sub DescriptionMatched
{
   my ( $txdesc ) = @_;
   foreach my $re ( @descREList )
   {
      return 1 if ( $txdesc =~ m/$re/ );
   }
   return 0;
}

sub main 
{
   processArguments();   
   BuildAccountsHierarchy(); #use --list arg to print this out
   $fromAcctGuid = AccountGuidFromPath( $fromAcctName );
   $toAcctGuid = AccountGuidFromPath( $toAcctName );
    
   #find all the transactions where 
   # description matches $descrRE
   # AND a split in that transaction (account guid) is $fromAcctGuid
   # replace the $fromAcctGuid with the toAcctGuid
   
   my $xpath;
   my $exp;
   #my @nodelist = ();
   my $numTxs   = 0;
   my $numMoves = 0;

   my @txNodes = $xmlDoc->findnodes("/gnc-v2/gnc:book/gnc:transaction" );
   $numTxs = @txNodes;


   if ( $numTxs > 0 ) {
      print STDOUT "There are $numTxs transactions in this file\n";
      my $txCnt = 0;
      foreach my $txNode ( @txNodes ) #these are the transactions
      {
         $txCnt++;
         #print $txNode->toString() ."\n" ;
         my ( $descN ) = $txNode->findnodes( "trn:description" );
#         print "desc=" .$desc ."\n";
         my $descText = $descN->textContent();
#         next if not $descText =~ m/$descrRE/;
         next if not DescriptionMatched( $descText );

         #have transaction of interest, get the splits
         my @splits = $txNode->findnodes( "trn:splits/trn:split" );
         print "found $#splits splits\n";
         foreach my $split( @splits )  
         {
            #print $split->toString(); 
            my ( $acctGN ) = $split->findnodes( "split:account" );
            #print $acctGN->toString() ."\n" ; exit;
            my $splitAcctGuid = $acctGN->textContent();
            #print "splitGuid=$splitAcctGuid looking for $fromAcctGuid\n" ;
            next if ( $splitAcctGuid ne $fromAcctGuid );
            #got it, replace the guid now
            $numMoves++;
            print "   " .  $split->toString() ."\n" ; 
            my $textN = $acctGN->firstChild();
            $textN->setData( $toAcctGuid );
            print STDERR "Replaced $fromAcctGuid ($fromAcctName) with $toAcctGuid ($toAcctName)\n" ;
            print STDERR "   Split is now   \n" . $split->toString() ."\n\n" ;
            last;
         }
      }
      print "Moved changed referenced account in $numMoves transactions\n"
   } 
   else 
   {
      print "no transacations found in this file... REALLY?\n" ;
   }

   if ( $outputFN )
   {
      open( $outputFH, ">", $outputFN );
      if ( not $outputFH ) {
            die "failed to open output file $outputFN for write\n" ;
      }
      print $outputFH $xmlDoc->toString; #write out the modified XML
      close $outputFH;
      print STDOUT "$outputFN contains the rewritten GnuCash file.\n" ;
   }
} #main

sub OpenFileForWrite
{
   my ( $FHR ,$fn ) = @_;
   if ( $fn )
   {
      if ($fn eq "-" )
      {
         $$FHR = *STDOUT;
      }
      else
      {
         open ( $$FHR ,">" ,$fn ) or die "could not open $fn for write\n" ;
      }            
   }
}

sub CheckFilenameClashes
{
   my $HR = {};
   foreach my $fn ( @_ )
   {
      next if not $fn;
      pod2usage( { -verbose => 0 , -msg =>"\n--->Clash of input or output file names: ($fn)\n" } ) if ( exists $HR->{$fn} ) ;
      $HR->{$fn} = 1;
   }
}

sub processArguments
{
   my $help = 0;
   my $man = 0;
   my $descrRE      = '';

   my $rstat = GetOptions(
       "pathSeparator=s"     => \$pathSeparator #globally defined
      ,"help!"               => \$help
      ,"man!"                => \$man
      ,"verbose+"            => \$verbose #globally defined
      ,"dumpAccounts=s"      => \$dumpFN
      ,"fromAcct=s"          => \$fromAcctName
      ,"toAcct=s"            => \$toAcctName
      ,"description=s"       => \@descREList
      );  


   my $p2u = 0;
   $p2u = 1 if $verbose;
   pod2usage( { -verbose => $p2u }  ) if $help;
   pod2usage( { -verbose => 2 }  ) if $man; 
   pod2usage( { -verbose => 0 , -msg =>"\n--->No input GnuCash file" } ) if not ( @ARGV );

   my $inputFN = $ARGV[0]; shift @ARGV;
   $outputFN = $ARGV[0] if ( @ARGV );

   CheckFilenameClashes(  
         $inputFN 
        ,$outputFN
        ,$dumpFN
        );

   OpenFileForWrite( \$dumpFH , $dumpFN ) if $dumpFN ne '';

   pod2usage( { -verbose => 0 , -msg =>"\n--->must specify --fromAcct, --toAcct, and at least one --description REGEX" } ) 
      if ( $dumpFN eq '' and ($fromAcctName eq '' or $toAcctName eq '' or not @descREList ) );
   pod2usage( { -verbose => 0 , -msg =>"\n--->must specify input GnuCash filename" } ) if ( not defined $inputFN ) ;
   pod2usage( { -verbose => 0 , -msg =>"\n--->Could not find $inputFN" } ) if ( not -f $inputFN ) ;

   #OK... should be good to go...
   $xmlDoc = XML::LibXML->load_xml( 
      location => $inputFN
      # parser options ...
      );
   die "Could not open or parse $inputFN... \nWas it gunziped?)\n" if ( not $xmlDoc ) ;
   if ( $outputFN ) {
      open ( $outputFH ,">", $outputFN ) or die "failed to open output file $outputFN for write\n" 
   } 
   
   print STDOUT "account path separator set to $pathSeparator\n" if $pathSeparator ne ":" ;

   if ( $outputFN ) 
   {
      open( $outputFH, ">", $outputFN );
      die "failed to open output file $outputFN for write\n" if not $outputFH ;
      print STDOUT "Output GnuCash file will be written to $outputFN\n" if $verbose ;
   }

}

main;


=pod 

=head1 SYNOPSIS
 
gc_move_splits.pl [options] CG-file.xml [modified-GC-file.xml]

options:

 --help                         print this synopsis help text
 --man                          print the full man page (this file's POD)
 --verbose                      increased verbosity (mainly for debugging)
 --fromAcctSplit=AccountPath    path of account the split should be move FROM
 --toAccountSplit=AccountPath   path of account the split should be move TO
 --dumpAccount=file|-           create a dump of account paths and guids
 --description=regex            Only move splits in transactions matching
                                description= my be repeated to specify more than one
 --pathSeparator=char           GnuCash account path separator (default=:)

The second file argument is is optional. With no destination output file,
gc_move_splits.pl runs in analytical/trial mode, and reports all 
actions taken and produces all specified analysis outputs.  

The source input file is never modified.

If your gnucash data file is compressed you must uncompress it first (on unix 
based OSes) as follows:

  cat gnucach_data_file gunzip > uncompressed_gnucash_file.xml

Or you can just uncheck the "compressed file" option in GnuCash and save.

=head1 DISCUSSION

The script reads an uncompressed "version 2" GnuCash 
XML datafile and writes a new file with the modified 
splits.


Splits to be moved are found by 

  1. Getting the Guid for the account from which the split is to be removed
  2. Getting the Guid for the account into which the split should be moved

Then traversing all transactions in the file looking for
  
  1. transactions with descriptions matching the input regex
  2. finding the split with the guid to be removed
  3. replacing the guid to be removed with the guid of the destination account


The script reads the GnuCash xml file I<as XML> B<not> as text.
The script uses XML::LibXML CPAN perl module to read, traverse modify
and output a new XML file. It is not dependant on the formating of the
gnucash XML unlike most perl scripts this author has seen on the GnuCash
users email list. 

Because this script does not treat the GnuCash file as text, it 
is not subject to the breakage that would occur if the formatting
of the XML data were to change. 

Instead, this script reads the GnuCash data a DOM structure, and 
then manipulates that structure.

The script does not modify the input GnuCash XML datafile.  The user must
specify an outout data filename.  The results of the script's 
operations are written to this file, which should then be opened and 
checked in GnuCash.  Before replacing the original file.

To print a usage synopsis:
   gc_move_splits.pl --help 

To print the synopsis, plus option descriptions:
   gc_move_splits.pl --help --verbose 

To print the entire man page:
   gc_move_splits.pl --man 


=head1 ENVIRONMENT

Because gc_move_splits.pl reads the input XML file I<as XML> using the
perl CPAN XML::LibXML module, using an XPath expression to find the bayes
matching data slots in each account, the script requires that your perl
environment have the CPAN XML::LibXML module installed.

The command

  perl -c -MXML::LibXML </dev/null

will report an error if the module is not installed in your environment.
Of course the script will report this also, because if it is not present,
the script will not compile.

=head2 Unix/Linux environments

Most Linux distributions make this available via the their standard package 
managers.  On Debian based distributions this can be installed with the 
following command:

   sudo apt-get install libxml-perl

On Unix/Linux environments this script should be made executable with the
chmod command

   chmod +x gc_move_splits.pl

=head2 Windows environments
 
XML::LibXML is also available in Active Perl, and in the cygwin environments.

This author has not tested this script on windows, but knows of no
reason why it will not work, once the required environment is installed.

On windows, the easiest way to run the script would be by 
using perl from a cmd prompt:

   perl gc_move_splits.pl

=head2 Macintosh environments

This author is not familiar with the OSX environment.  But knows it is
based on BSD Unix.  The script should run from a terminal prompt, once
the requisit, LIBXml is installed in the perl environemnt.  Patches to
these instructions are welcome.

=head1 OPTIONS

All options may be abbreviated as long as the option is distinct from
all other options.

=head2 --description='regex'

This regular expression is used for identifying transaction splits to be
moved or retargeted to another account. 

This switch may be specified multiple times to specify multiple Regexes:

   --descri='^Check' --descr='United Way'

The first will find "Check" at the beginning of a transaction description.
The second will find "United Way" anywhere in the transaction description.


=head2 --verbose

Print very verbose output to STDOUT. Used for debugging. Don't bother.
Besides, this is also not very well implemented in this script at
this time.

=head2 --help (or -h)

Print help text.

=head2 --path(Separator)=:

Specifies the character used as the path separator in your GC
datafile. The default value is a colon (:)

=head2 --man

Print the full man page documentation

=head2 --fromAcctSplit=

Full path of account we what to move the split FROM.

=head2 --toAcctSplit=

Full path of account we what to move the split TO.

=head2 --description

Specifies the regex that will be looked for in the transaction
description.  May be repeated.

=head2 --dumpAcct=file|-

Dump the full paths for all the accounts in the GC file to either
the file specified or to STDOUT, if "-" is used. 

=head1  AUTHOR

Lincoln A. Baxter
email:  my intials (all three) (at) lincolnbaxter (dot) com




