#!/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_prune_bayes_data.pl

=head1 COPYRIGHT

Copyright (C) 2015 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
 
Remove Bayes data associated with one or all accounts in an 
uncompressed GnuCash XML data file.

This enables the user to analyze, modify, trim (purge), or delete 
bayesian data from his GnuCash data file. 

The script reads an uncompressed "version 2" GnuCash 
XML datafile and removes all Bayes data that references
non-existent accounts.

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 the breakage 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_prune_bayes_data.pl --help 

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

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

=cut



#global variables
my $helptext = "";
my $verbose = 0;
my $xmlDoc = undef; 
#file handles
my $listFH = undef;
my $bayesActFH = undef;
my $outputFN = undef;
my $outputFH = undef;
my $rewriteFH = undef;
my $saveslotsFH = undef;
my $orphanedFH = undef;
my $matchingFH = undef;
my $kvpFH = undef;

#global hash references...
my $renameHR = {};
my $pathHR = {}; #for looking up by the full account path
my $accountGuidHR = {}; #map guid to name
my $onlyAccountsHR = {};
my $pathSeparator = ":" ; #use the --pathSeparator switch to change

my $substExpressionsHR = {};
my @remRegexes = ();

sub BuildAccountsHierarchy #non destructive... useful to extract?
{
   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;
   }

   #print Dumper( $pathHR );
   #print Dumper( $accountGuidHR );
}

sub ListAccounts($)
{
   my ( $fh ) = @_;
   if ( $fh )
   {
      foreach my $key ( sort keys %$pathHR )
      {
         print $fh $pathHR->{$key} . " '$key'\n" ; 
      }
   }
}

#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;
}

sub ListKVPs
{
   my ( $keyNode ,$level ) = @_;
   my $indent = "";
   my $i = $level;
   while ( $i-- ) { $indent .= "  "; }

   my $key = $keyNode->textContent();
   print $kvpFH $indent."key=$key\n" ;

   my $valueNode = $keyNode->nextNonBlankSibling();
   my $attr;
   if ( $attr = $valueNode->getAttribute( "type" ) )
   {
      if ( $attr eq "frame" )
      {
         print STDOUT "findnodes after " .__LINE__ ."\n" if $verbose >= 2;
         foreach my $cn ( $valueNode->findnodes( "slot/slot:key" ) ) 
         {
            ListKVPs( $cn ,$level+1 )
         }
      }
      else
      {
         print $kvpFH $indent ."value=" .$valueNode->textContent() ."\n";
      }
   }
}

my $numRemoved = 0;
sub RemoveSlot
{
   my ($node ,$key ,$why ) = @_;     #$node is the slot whose parent we want to remove
   my $parent = $node->parentNode(); #the actual slot to remove
   my $grand = $parent->parentNode();
   my $removedSlot = $parent;
   #print STDOUT "RemoveSlot grand=$grand\n" if $verbose > 2;
   print $saveslotsFH "Removing slot key=$key $why\n      " 
               . $parent->toString() ."\n-----\n" if defined $saveslotsFH;
   $grand->removeChild( $parent );
   $numRemoved++;
   print STDOUT "findnodes after " .__LINE__ ."\n" if $verbose >= 2;
#   if ( not $grand->findnodes( '*/slot:key' ) )
#   {
#      my $ggrand = $grand->parentNode();
#      my $gggrand = $ggrand->parentNode();
#      print $saveslotsFH "Removing empty frame slot = " . $ggrand->toString() ."\n" if defined $saveslotsFH;
#      $removedSlot = $ggrand;
#      $gggrand->removeChild( $ggrand );
#      $numRemoved++;
#   }
   return $removedSlot;
}

my $numMatching = 0;
sub RemoveSlotsMatchingRegexes
{
   my ( $keyNode ,$level ) = @_;
   my $i = $level;
   my $indent = "";
   while ( $i-- ) { $indent .= "  "; }
   my $removedSlot;
   my $removed = 0;
   my $key = $keyNode->textContent();
   foreach my $re ( @remRegexes )
   {
      if ( $key =~m/$re/ )
      {
         print STDOUT "$indent (level=$level) key=$key matched regex=$re\n" if $verbose >= 2;
         
         $removedSlot = RemoveSlot( $keyNode, $key, "matches Regex=$re" );
         $removed++;
         $numMatching++;
         print STDOUT "Removed Slot = " .$removedSlot->toString() . " at line " .__LINE__ ."\n" if $verbose >= 2;
         #exit;
         last;
      }
   }
   
   if ( not $removed )
   {
      print STDOUT "RemoveSlotsMatchingRegexes: looking for children \n" if $verbose >= 2;
      #now look for children...
      my $valueNode = $keyNode->nextNonBlankSibling();
      my $attr;
      if ( $attr = $valueNode->getAttribute( "type" ) )
      {
         if ( $attr eq "frame" )
         {
            #have children... recurse
            print STDOUT "findnodes after " .__LINE__ ."\n" if $verbose >= 2;
            foreach my $cn ( $valueNode->findnodes( "slot/slot:key" ) ) 
            {
               RemoveSlotsMatchingRegexes( $cn ,$level+1 ) #recurse
            }
         }
      }

   }

   #print STDOUT "removed=$removed\n" ;
   return $removedSlot;
}

my $subRegexesHR = {};
my $numSubstitutions = 0;
sub ApplySubstitutions
{
   my ( $frame ,$level ) = @_;
   return if not keys %$subRegexesHR ; 
   my $i = $level;
   my $indent = "";
   while ( $i-- ) { $indent .= "  "; }

   my @keynodes = FrameSlotChildKeys( $frame );
   foreach my $keyNode ( @keynodes )
   {
      my $key = $keyNode->textContent();
      foreach my $re ( keys( %$substExpressionsHR ))
      {
         my $newkey = $key;
         my $evalStr = "\$newkey =~ $re ;" ;
         eval $evalStr;
         if ( $@ ) 
         {
            print "Substitution Regex='$re' failed to eval() removing skipping this substition\n" ;
            #need to remove this $re from subsequent execution
            delete $substExpressionsHR->{$re};
         }
         elsif ( $key ne $newkey ) 
         {
            #set the newkey into the $keyNode
            SetKeyNodeText($keyNode, $newkey );
            $numSubstitutions++;
            print STDOUT "regex $re converted slot key value='$key' to '$newkey'\n" ;#debug
         }
      }
      #now look for children... and recurse if found
      my $frameValue = GetFrameValue( $keyNode );
      if ( $frameValue )
      {
         ApplySubstitutions( $frameValue ,$level+1 );
      }
   }
}

sub SetKeyNodeText($$)
{
   my ($keynode, $text );
   #foreach my $keychild ( $node->childNodes() )
   my ( $keychild ) = $keynode->childNodes();
   if ( $keychild )
   {
      $keychild->setData( $text );
   }
   else
   {
      die "SetKeyNodeText: Could not get keychild text node for " . $keynode->toString ."\n" ;
   }
}
sub ListAccountKVPs($$)
{
   my ( $keynodesRef, $acntpath ) = @_;
   my $cnt = 0;
   if ( $kvpFH )
   {
      print $kvpFH
        "----------------------------------------------\n" .
        "KV Pairs for Account: $acntpath\n" .
        "----------------------------------------------\n"
      ;
      foreach my $node ( @$keynodesRef ) 
      {
         $cnt++;
         ListKVPs( $node ,1 ) #recursive
      }
   }
}

sub FrameSlotChildKeys($)
{
   my ( $frame ) = @_;
   die "how can I be looking for frame children if \$frame is not frame\n" if ( not IsFrame( $frame ) );
   return $frame->findnodes( 'slot/slot:key' ) ;
}

sub GetValueNode
{
   my ( $keynode ) = @_;
   return $keynode->nextNonBlankSibling();
}

sub IsFrame
{
   my ( $valuenode ) = @_;
   my $attr = $valuenode->getAttribute( "type" );
   return ( defined $attr and ($attr eq "frame") ) ;
}

sub IsEmptyFrame
{
   my ($frame) = @_;
   return 0 if not IsFrame( $frame );
   my $txt = $frame->toString();
   if ( $frame->findnodes( 'slot/slot:key' ) )
   {
      return 0;
   }
   else
   {
      return 1;
   }
}

sub GetFrameValue
{
   my ( $keynode ) = @_;
   my $value = GetValueNode( $keynode );
   return $value if IsFrame( $value );
   return 0;
}


my $emptycnt = 0;
my $numRenamed = 0;
my $numOrphaned = 0;
my $orphanedHR = {};
sub ProcessChildSlots($$) #this is where the real work is done for each account we are processing :-)
{
   my ( $frame ,$acntpath ) = @_; #this is  the top level value frame of the slot with key of import-map-bayes 
   if ( not IsFrame($frame) ) 
   {
      print STDERR "ProcessChildSlots: \$frame is not frame slot\n" ;
      print STDERR $frame->toString() ."\n" ;
      exit;
   }

   my @keynodes;
   my $cnt;

   print STDOUT "frame=\n" .$frame->toString() ."\n" if $verbose >= 3;
   print STDOUT "ProcessChildSlots after " .__LINE__ ."\n" if $verbose >= 2;
   @keynodes = FrameSlotChildKeys( $frame ); my $line = __LINE__;
   $cnt = 0;
   if ( not @keynodes )
   {
      print STDERR "Could not get frame's child slot keys at $line\n" ;
      print STDERR "frame = " .$frame->toString() ."\n" ;
      return;
   }
   #each node has a slot:key and a slot:value which is frame 
   #the frame has more sub slots, where the slot/slot:key is an account reference
   ListAccountKVPs(\@keynodes, $acntpath ) if ( $kvpFH );

   #now remove slots with keys match regexes, if any
   my $removed ;
   if ( @remRegexes ) 
   {
      print STDOUT "findnodes after " .__LINE__ ."\n" if $verbose >= 2;
      foreach my $node ( @keynodes )
      {
         $removed = RemoveSlotsMatchingRegexes( $node ,0 ); #recursive
      }
   }
   if ($removed eq $frame )
   {
      print STDERR __LINE__ . ": REALLY? how did we get here?\n (we should not have removed frame slot:\n " ;
      die $removed->toString() ."\n ";
   }

   ApplySubstitutions( $frame ,0 );

   RenameAccountReferences($frame);

   #now remove any empty slots resulting from above removals
   RemoveEmptySlots( $frame ,$acntpath );  

   return 1;
} #ProcessChildSlots

sub RenameAccountReferences
{
   my ( $frame ) = @_;
   #now rename account references... (and remove orphaned account references
   print STDOUT $frame->toString() ."\n" if $verbose >= 3 ;
   print STDOUT "findnodes after " .__LINE__ ."\n" if $verbose >= 2;
   my @keynodes = $frame->findnodes( 'slot:value/slot/slot:key' ); #looking deeper for the keys holding acntpaths
   print STDOUT "findnodes after " .__LINE__ ."\n" if $verbose >= 2;
   my $cnt = 0;
   foreach my $node ( @keynodes )
   {
      $cnt++;
      my $text = $node->textContent();
      #first see if we should rename it
      #do we have it in the gc file... 
      if ( not defined $pathHR->{$text} )
      {
         $orphanedHR->{$text} = 1 if $orphanedFH;
         if ( exists $renameHR->{$text} )
         {
            SetKeyNodeText( $node, $renameHR->{$text} );
            $numRenamed++;
            next;
         }
         #non-existent accounts remove the slot acccount reference
         #if we get here, remove it
         RemoveSlot( $node ,$text ,"references non-existent account" );
         $numOrphaned++;
      }
   }
}

sub RemoveEmptySlots
{
   my ( $frame ,$acntpath ) = @_;
   my @keynodes = FrameSlotChildKeys( $frame );
   foreach my $keynode ( @keynodes )
   {
      my $txt = $keynode->textContent();
      my $value = GetValueNode( $keynode );
      if ( IsEmptyFrame($value) )
      {
         $emptycnt++;
         RemoveSlot( $keynode, $txt ,"value node for this key is empty frame" );
      }
   }

   if ( IsEmptyFrame( $frame ) )
   {
      print STDOUT "calling RemoveSlot after " .__LINE__ ."\n" if $verbose >= 2;
      print STDOUT "Removing import-map-bayes slot from account $acntpath\n" ;
      $emptycnt++; 
      RemoveSlot( $frame ,"toplevel frame for account $acntpath" ,"is empty" );
   }
}


sub CheckRenameTargetAccounts
{
   my $rerr = 0;
   foreach my $path ( values %$renameHR )
   {
      if ( not defined $pathHR->{$path} )
      {
         $rerr++;
         print STDERR "Account '$path' not found in this file\n" ;
      }
   }
   die "$rerr errors in rename file\n" if $rerr ;
}

#  gnc:account
#    act:slots
#      slot
#        slot:key   // we are looking for import-map-bayes slots
#        slot:value // will be a frame when it is import-map-bayes slots
#          slot
#             slot:key     // contains bayes tokens
#             slot:value   // this will be a frame for import-map-bayes slots
#                slot
#                   slot:key   // contains accountPATH references
#                   slot:value // this is always an integer weight for chosing the above account


sub GetImportMapBayesSlots($)
{
   my ( $doc ) = @_;
   my $xpath;
   my $exp;
   my @nodelist;

   $xpath = "/gnc-v2/gnc:book/gnc:account/act:slots/slot/*[text()='import-map-bayes']" ;
   $exp = XML::LibXML::XPathExpression->new( $xpath );
   @nodelist = $doc->findnodes($exp);
   die "could not find import-map-bayes slots in this file\n" if not @nodelist ;    
   my $numnodes = @nodelist;
   if ( $numnodes > 0 ) 
   {
      print STDOUT "$numnodes accounts contain import-map-bayes slot data\n";
   }
   return @nodelist
}

sub main 
{
#   usage() if ( not @ARGV );
   processArguments();   

   BuildAccountsHierarchy(); #use --list arg to print this out
   ListAccounts( $listFH );
   CheckRenameTargetAccounts(); #verity that destination accounts exist

   my @nodelist;
   @nodelist = GetImportMapBayesSlots( $xmlDoc );

   my $nodecnt = 0;
   foreach my $keynode ( @nodelist ) #these are the import-map-bayes key nodes...
   {
      $nodecnt++;
      my $slot = $keynode->parentNode(); #this is the parent containing the import-map-bayes
      my $actslots = $slot->parentNode(); #the parent of all slots in this account
      my $acct = $actslots->parentNode(); #this is the account

      #now find the name of the account we are modifying
      my ( $namenode ) = $acct->findnodes( "act:name" );
      my $actname = $namenode->textContent();
      my ( $guidnode ) = $acct->findnodes( "act:id" );
      my $accguid = $guidnode->textContent();
      my $acntpath = AccountPath( $accguid );

      #if we are only processing some accounts... not very useful -- I may remove this
      if ( keys %$onlyAccountsHR )
      {
         next if not defined $onlyAccountsHR->{$acntpath};
      }
      if ( $bayesActFH ) {
         #print $bayesActFH $actname ."\n" ;
         print $bayesActFH "'$acntpath'\n" ;
      }

      print STDOUT "Processing import-map-bayes slots in account: $actname\n" if $verbose;
      my $frame = GetValueNode( $keynode );
      ProcessChildSlots($frame, $acntpath ); 
#      my $bayesParent = $node->nextNonBlankSibling; #this is the slot:value type='frame' node
#      my @bayesChildren = $bayesParent->childNodes; #get all the child slots...
#      foreach my $bayesChild (@bayesChildren )
#      {
#         next if not $bayesChild->hasChildNodes(); 
#         ProcessChildSlots( $bayesChild ,$acntpath ); #this is the account's import-map-bayes frame
#         #print STDOUT "\n$acntpath\n" .$bayesChild->toString();
#      }
   } 

   if ( $orphanedFH )
   {
      my $numor = 0;
      foreach my $k ( sort keys %$orphanedHR )
      {
         $numor++;
         print $orphanedFH "'$k'\n" ;
      }
      close $orphanedFH;
      print STDOUT "Wrote $numor orphaned account references to orphaned accounts file\n" if $verbose ;
   }
   my $renamed = ( $outputFH ? "Renamed" : "Would have renamed" );
   my $removed = ( $outputFH ? "Removed" : "Would have removed" );

   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 "Replaced $numRenamed import-map-bayes slot account references\n" if keys %$renameHR;
   print STDOUT "$removed $numMatching slots matching regexes: @remRegexes\n" if @remRegexes ;
   print STDOUT "$removed $numOrphaned slots which reference accounts that don't exist\n" ;
   print STDOUT "$removed $emptycnt slots which were empty as a result of processing\n" ;
   my $total = $numRenamed + $numMatching + $numOrphaned +$emptycnt;
   print STDOUT "Modified or removed a total of $total slots\n";
   print STDOUT "$outputFN contains the rewritten GnuCash file.\n" if $outputFN;

} #main

#my $copyleft = qq[
#$0 Copyright (C) 2015 Lincoln A. Baxter
#This program comes with ABSOLUTELY NO WARRANTY;
#This is free software, and you are welcome to redistribute it
#under certain conditions. 
#    
#(see http://www.gnu.org/licenses/gpl-3.0.en.html)
#
#];
#
#sub usage
#{
#   print STDOUT $copyleft;
#   die "Usage: $0 [options] inputfile outputfile\n" ;
#}

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 $onlyFN = "";
   my $listActFN = "";
   my $listBayesFN = "";
   my $orphanedFN = "";
   my $kvpFN = "";
   my $renameFN = "";
   my $saveslotsFN = "";
   my @subRegexes = ();
   my @substExpressions = ();
   my $help = 0;
   my $man = 0;

   my $rstat = GetOptions(
       "listAccounts=s"      => \$listActFN 
      ,"listBayesAccounts=s" => \$listBayesFN
      ,"orphaned=s"          => \$orphanedFN
      ,"listKVP=s"           => \$kvpFN
      ,"rename=s"            => \$renameFN
      ,"removed=s"           => \$saveslotsFN
      ,"pathSeparator=s"     => \$pathSeparator #globally defined
      ,"removeRegex=s"       => \@remRegexes #globally defined
      ,"substExpression=s"   => \@substExpressions
      ,"help!"               => \$help
      ,"man!"                => \$man
      ,"verbose+"            => \$verbose #globally defined
      ,"only=s"              => \$onlyFN
      );  


   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 on command line" } ) if not ( @ARGV );

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

   CheckFilenameClashes(  
         $inputFN 
        ,$renameFN
        ,$outputFN
        ,$listActFN 
        ,$listBayesFN 
        ,$orphanedFN 
        ,$kvpFN 
        ,$saveslotsFN 
        ,$onlyFN 
        );

   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 ) ;
   pod2usage( { -verbose => 0 , -msg =>"\n--->Could not find $onlyFN" } ) if ( $onlyFN and not -f $onlyFN ) ;
   pod2usage( { -verbose => 0 , -msg =>"\n--->Could not find $renameFN" } ) if ( $renameFN and not -f $renameFN ) ;


   #OK... should be good to go...read the input gc xml file
   $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" 
   } 
   
   OpenFileForWrite( \$listFH ,$listActFN );
   OpenFileForWrite( \$bayesActFH ,$listBayesFN );
   OpenFileForWrite( \$orphanedFH ,$orphanedFN );
   OpenFileForWrite( \$kvpFH ,$kvpFN );
   OpenFileForWrite( \$saveslotsFH ,$saveslotsFN );
   print STDOUT "GC account path separator set to $pathSeparator\n" if $pathSeparator ne ":" ;

   GetAccountRenames( $renameFN ) ;
   GetOnlyAccounts( $onlyFN ); 

   if ( @remRegexes )
   {
      foreach my $re ( @remRegexes ) 
      {
         print STDOUT "Will remove slot keys matched by regular expression: $re\n" if $verbose ;
      }
   }

   if ( @substExpressions )
   {
      foreach my $re ( @substExpressions ) 
      {
         $substExpressionsHR->{$re} = 1;
         print STDOUT "Will apply the substition expression: $re to slot key text\n" if $verbose ;
      }
   }
   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 ;
   }

#   my $rewrite_file = "";
#   if ( @ARGV ) {
#         $rewrite_file = $ARGV[0];
#         if ( $rewrite_file ne "" ) 
#         {
#            open( $rewriteFH, ">", $rewrite_file );
#            if ( not $rewriteFH ) {
#               die "failed to open output file $rewrite_file for write\n" ;
#            }
#            print $rewriteFH $xmlDoc->toString();
#            print STDOUT "$rewrite_file contains rewritten (but unmodified) $ifname\n" ;
#            close $rewriteFH;
#         }
#      }

} #processArguments

sub GetOnlyAccounts($)
{
   my ( $fn ) = @_;
   if ( $fn ) #input control file
   {
      my $onlyfh ;
      open $onlyfh , $fn or die "could not open $fn for read\n" ;
      my @onlyacts = <$onlyfh>;
      chomp( @onlyacts );
      foreach my $an ( @onlyacts ) 
      {
         $an =~ s/^'//;
         $an =~ s/'$//;
         print "will only prune import-map-slots from Account '$an' \n" if $verbose;
         $onlyAccountsHR-> {$an} = 1;
      }
      #print Dumper( $onlyAccountsHR );
   }
}

sub GetAccountRenames
{
   my ( $filename ) = @_;
   print STDOUT "rename file is $filename\n" if $verbose;
   if ( $filename ) #input control file
   {
      my $fh;
      open $fh ,"<" ,$filename or die "could not open $filename for read\n" ;
      my @lines = <$fh>;
      chomp @lines;
      my $err = 0;
      my $cnt = 0;
      foreach my $line ( @lines )
      {
         $cnt++;
         if ( $line =~ m/'(.*)'[:,\/\s]{1,}'(.*)'$/ ) 
         {
            $renameHR->{$1} = $2;
         }
         else
         {
            print STDERR "$filename: line $cnt: did not understand $line\n" ;
            $err++;
         }
      }
      #print Dumper $renameHR;
      if ( $err )
      {
         print STDERR "$cnt errors in rename file: $filename\n";
         print STDERR "Format: expected account paths in baby quotes (') separated by one for more of :,/ or white space e.g.:\n";
         die   "'from:acct:path','to:account:path'\n" ; 
      } 
   }
}

main;


=pod 

=head1 SYNOPSIS
 
gc_prune_bayes_data.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)
 --only=only_acts.txt           (input)  only operate on these accounts
 --rename=slot_acts.txt         (input)  for renaming slot keys 
 --listKVP=kvps.txt             (output) print a Bayes KVP report by account
 --listAccounts=accounts.txt    (output) print full GC path of all accounts 
 --listBayesAccounts=filename   (output) accounts with bayes data
 --removed=removed.txt          (output) writes the XML of removed slots
 --orphaned=orphaned.txt        (output) writes orphaned slot keys
 --pathSeparator=char           GnuCash account path separator (default=:)
 --removeRegex=regex            prune slots matching regular expresions (repeatable)
 --substExpresssions=expression sed like substition patterns applied
                                to slot key names (repeatable)

The second file argument is is optional. With no destination output file,
gc_prune_bayes_data.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

Initially (when you start out with GnuCash, or with a new account),
you have to "train" the matcher by manually identifying the destination
account for every transaction.  When you do, (assuming you have enabled
Bayesian matching on import), the matching will remember you choices by
storing transaction description data and the account you selected in
key/value pairs called "slots" under the account you we importing into.
The values of an existing slots will be incremented making the matching
stronger for the balancing account selected.

When the matcher builds up a strong enough match for a
particular account, the importer will propose that account as 
the destination account, and it will show you the match "strenth."

This works very well when one is consistent.

When the matcher can not make up its mind the importer will ask you to choose a 
destination account.

Problems can creep in for the following reasons:

=over

=item 1 Accounts have been renamed

In this case the bayes keys end up referencing accounts names that
no longer exist. Unfortunately, as someone on the GC user list pointed out, 
the bayes key values for accounts the reference, reference them by name not by the 
account's UUID (GUID). This means that when accounts are renamed in 
GnuCash all the bayes that reference the original account name become as this
author puts it "orphaned" -- they no longer reference existing accounts. 

This author had done a lot of renames over time.

=item 2 Inconsistent balancing accounts selected during import

This happens when you purchase items from the same vendor -- Home Depot, 
for instance -- but the purchases were for different purposes, 
so you balance the transactions with different expense accounts. 
In this authors experience, the matcher almost never even selects
a destination account during import. And when if it does, it is often
not the right account for the subject transaction.

=item 3 You have imported unbalanced transactions

If you allow transactions to be imported without balancing accounts, then
GnuCash will balance them in a default "Imbalance" account.  This might 
happen because you want to get the transactions imported, but you want to fix
the imbalance transactions later.  Maybe you had already spent a lot of time
selecting accounts and wanted get the them import finished, but there were
still some transactions, that unbalanced.  These will be balanced by default to
Imbalance account.  I<The Bayes slot data will remember this!>  Perhaps, the importer
should explicity B<NOT> remember unbalanced transactions. The author may decide to 
volunteer some time to work the the importor, and if I do, this is one "feature"
I would want to fix.

=back

=head2 Degredation over time

Over a long period of time, even when you have been careful with balancing account
selections, the matching account selection can degrade significantly (see reason 2 above). 
Eventually this authors frustration rose to the level of desiring to "fix something" 
or delete all the Bayes data and start over.  Finally this lead to this script.

=head2 Repairing GnuCash Bayes slot data

This script will allow one remove or repair Bayes slot data associated with 
all or individual accounts in a GnuCash xml data file. If you remove all
Bayes data in an account, the account will be returned to the state it was
in at the time you first created it, and you will have to identify balancing
accounts for transactions imported into it.

Instead of starting over, however, this script will allow you to "prune" or edit
the bayes slot data.  By default, all bayes data referencing accounts that no longer
exist in the GnuCash data file are removed.

The script will also allow you to "adjust" or tune the the bayes data in one or all
accounts.  

=head2 Details: GnuCash Bayes Matching Data 

The Bayes matching data is stored in the GnuCash data file, in "slots"
associated with accounts that have been target of transaction imports as 
as hierachical "Key/Value" pairs.  The Bayes data slots are stored in
a toplevel "frame" slot (array) with the name of import-map-bayes:

   <slot:key>import-map-bayes</slot:key>

The array of slots with this slots' "frame" contains the KVPs written
by the importer when Bayesian matching is enabled.

      <slot:key>import-map-bayes</slot:key>
      <slot:value type="frame">
        <slot>
          <slot:key>#000001342</slot:key>
          <slot:value type="frame">
            <slot>
              <slot:key>Expenses:Auto:Repair and Maintenance</slot:key>
              <slot:value type="integer">1</slot:value>
            </slot>
            <slot>
              <slot:key>Expenses:Auto:Fuel</slot:key>
              <slot:value type="integer">1</slot:value>
            </slot>
          </slot:value>
        </slot>
        <slot>
          <slot:key>#000001359</slot:key>
          <slot:value type="frame">
            <slot>
              <slot:key>Expenses:Gifts</slot:key>
              <slot:value type="integer">1</slot:value>
            </slot>
          </slot:value>
        </slot>

The line 

   <slot:key>#000001342</slot:key>

in the above, represents a word from a transaction descript that has been imported.
The value of this slot key is a frame (array) of slots that provide account names

   <slot:key>Expenses:Auto:Repair and Maintenance</slot:key>
   <slot:key>Expenses:Auto:Fuel</slot:key>

And the matching "strength" values for the named account

   <slot:value type="integer">1</slot:value>


=head1 ENVIRONMENT

Because gc_prune_bayes_data.pl reads the input XML file I<as XML> using the 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 install 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_prune_bayes_data.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 there should be 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_prune_bayes_data.pl

=head2 Macintosh environments

This author is not familiar with the OSX environment.  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 --listKVP=filename

Specifies a file into which while be written the Bayes
key/value pairs for each account in the GnuCash file. This 
is useful for analyzing your bayes matching data in n easy to read
abbreviated (indented) format.


=head2 --only=filename     

Specifies an input control file which is expected to contain a list
of account paths from which import-map-bayes slots will be pruned. 

=head2 --listBayesAccounts=filename

Specifies a file to which the account paths with bayes import data will be
written (just names the accounts that contain import data). This can be
used to create in input file for L<--onlyFile=filename)>.

=head2 --listAccounts=filename 

Specifies a file to which will be written a list accounts in the
gnucash file.  The full account path name is written.  If filename is
'-' then the files will be listed to STDOUT

This is may be useful for creating the following input files specified by other
options. 

=head2 --orphanedFile=filename

Specifies an output file to which will be written a list of orphaned
account paths.  This is the list of references that do not refer to an
existing account.

This can be used in conjunction with the --listAccounts file to create a 
renameFile. 

=head2 --renameFile=filename

Specifies a file of from/to account paths. Bayes slot data the matchs the 
'from' path, will be replaced with the 'to' path. This is the best way
to retain slot data for accounts that have been renamed.

The file is expected in the form of baby quoted (') 'from' and 'to' paths one per line.
The regular expression used to parse this is 

     '(.*)'[:,\/\s]{1,}'(.*)'$  

Any of ":", "," "/", space, or tab, (one or more) can be used as a separators between 
the from and to account paths.

=head2 --removeRegex='regex'

The bayesian matcher tokenizes transaction descriptions on word boundaries (delimited by
white space).  It is argued that this creates a lot of fairly useless key to account 
relationships.  This option can be used to remove key/value pairs using regular expression matching
against the slot keys.

Purely numeric keys can be removed as follows:

   --removeRegex='^\d{1,}$'

Similarly, 

   --removeRegex='^#\d{1,}$'

would remove all slots whose keys start with a hash (#) and are purely numeric after the hash.

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

=head2 --saveslots=filename  

Specifies a file to which will be written the removed slots in XML format. Use if you want to 
save the XML version of the slot data for some paranoid reason.  This was implemented because
the author was originally paranoid.

=head2 --verbose

Print very verbose output to STDOUT. Used for debugging. Don't bother

=head2 --help (or -h)            : print help text

=head2 --path(Separator)=:       : the character used as the path separator in 
                                your GC datafile default value is a colon (:)

=head2 --help (or -h)            : print this help text

=head2 --path(Separator)=:       : the character used as the path separator in 
                                your GC datafile default value is a colon (:)

=head2 --substString=substitution_pattern

   --subst='s/fromRegex/toRegex/' #or 
   --subst='s,fromRegex,toRegex,' 
   
repeat as often as you need

Substition expressions used to edit slot key values.  The regular
expression is executedly literally in a perl eval().  If the eval fails,
a message will be written to STDERR, and the supstitution regex will be
removed from the list.




=head1 Examples
 
=head2 gc_prune_bayes_data.pl --listA=- uncompressed_gcfile 
 
List all accounts in the input file to stdout  A file make be provided instead of -

=head2 gc_prune_bayes_data.pl --onlyFile=only.txt source-CG-file.xml rewritten-GC-file.xml
  
Operate only on the accounts specified in only.txt. Produce rewritten-GC-file.xml
with the results of the operations specified.

=head2 gc_prune_bayes_data.pl

prune bayes data from all accounts and write and updated gcfile
 
gc_prune_bayes_data.pl uncompressed_gcfile modified_gcfile


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




