#!/usr/local/bin/perl # engine.pl - the CBB 'engine'. # This script implements a transaction abstract data type # It encapsulates a list a transactions and the functions # required to manipulate the transactions. # # Written by Curtis Olson. Started August 22, 1994. # # Copyright (C) 1994 - 1999 Curtis L. Olson - curt@me.umn.edu # # 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 2 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. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # $Id: engine.pl,v 1.2 2000/01/02 19:08:02 curt Exp $ package CBB; use strict; # don't take no guff # @INC specifies the installed location of the necessary pieces. # It should already be setup by wrapper.pl require "common.pl"; require "log.pl"; $| = 1; # flush buffers after every write if ( $CBB::logging != 0 && $CBB::logging != 1) { # if not specified elsewhere, turn on logging $CBB::logging = 1; # 0 = off, 1 = on } if ( $CBB::debug != 0 && $CBB::debug != 1) { # if not specified elsewhere, turn off debugging. $CBB::debug = 0; # 0 = off, 1 = on } # Global variables # %CBB::TRANS - an associative array of transactions and transaction keys # @CBB::KEYS - a sorted list of transaction keys (for traversing the trans list) # $CBB::sorted_keys - specifies whether the list in @CBB::KEYS is valid # $CBB::calced - specified whether the transactions have been properly calculated # $CBB::current - specifies the "current" position in the @CBB::KEYS array # $CBB::current_file - full name of currently opened transaction file # %CBB::BALS - an associative array used to store account information # $CBB::version - version number (set in common.pl) # $CBB::duplicate - flag to decide what to do with duplicate read-in entries &init_trans(); # initialize %CBB::TRANS, @CBB::KEYS, and $CBB::sorted_keys open(DEBUG, ">debug") if $CBB::debug; # toggle debugging sub debug { # in: flag # out: flag my($newdebug) = @_; if ($newdebug == 1) { # turning debugging on if ($CBB::debug == 1) { # already on, do nothing } else { $CBB::debug = 1; open(DEBUG, ">debug"); } } else { # turning of debugging if ($CBB::debug == 0) { # already off, do nothing } else { $CBB::debug = 0; close(DEBUG); } } return $CBB::debug; } # get next available key for a specified date sub get_next_key { # in: date, transaction information # out: key my($date) = shift; my($info) = shift; my($count) = 0; my($trans); my($key); my($founddup) = 0; # Take off the total, that changes with each entry so # we don't want to compare it $info =~ s/\t[^\t]*$//; # If we are to check for duplicates and the date field is unchecked # in the "compare for duplicates" preference window, then we need to # check every date. if ($CBB::duplicate && !($CBB::compare & 0x01)) { foreach $key (keys(%CBB::TRANS)) { $trans = $CBB::TRANS{$key}; # Check if the key doesn't contain the date for this transaction return(undef) if(!&CheckTrans(\$founddup, $info, $trans)); } } # Keep adding to the count if we already have a key with a certain # count and the check number (if there is one) for the transaction # with that key is less (or equal) than the check number of the transaction # to insert. If both transactions don't have check numbers, the return # value will be 0 (the same as if both transactions had the same check # number). We do this to order same-day transactions with # different check numbers in the correct order. This will happen # if not entering check transactions in numerical order. # # We still might need to check for duplicates when the date field is # being compared (which means the above check wouldn't have been done). # This loop insures that every comparison will be on the same date so # in case, checking dates is easy. We only need to compare if we # have to compare dates. $trans = $CBB::TRANS{"$date-".&pad($count)}; while (defined($trans) && &CompareCheckNums($trans, $info) <= 0) { # Check for duplication return(undef) if ($CBB::duplicate && ($CBB::compare & 0x01) && !&CheckTrans(\$founddup, $info, $trans)); $count++; $trans = $CBB::TRANS{"$date-".&pad($count)}; } # If we exited the while() loop with a key that is already being used, # then that means we have a new transaction that needs to be inserted # ahead of other transactions already posted on this date. This will # sort transactions, not only based on date, but on check number. # # If we have this situation, then we need to change the keys of some # of the already posted transactions to fit this new one in if (defined($trans)) { # Change the key for the transaction with this count &ChangeKey($date, $count); } return "$date-".&pad($count); } sub CheckTrans { # in: found duplicate flag # out: 1 = keep processing, 0 = don't insert my($founddup) = shift; my($info) = shift; my($trans) = shift; my($arg1); my($arg2); # If we already found a duplicate, then we have already asked the user, # the user had said to insert, and we might match another # entry that is exactly the same (which would happen if there # were already 2 or more entries that are the same) if(!$$founddup && &CompareTrans($info, $trans)) { return(0) if ($CBB::duplicate == 1); # Never insert # Found a duplicate $$founddup = 1; # Set up transactions for dialog box argument SetupForArg($info, \$arg1); SetupForArg($trans, \$arg2); # Ask user how to handle the duplicate transaction system("dialog4duplicate $arg1 $arg2"); return(0) if ($? != 0); # User elected to NOT insert trans } return(1); } sub SetupForArg { # in: transaction # out: message suitable for a dialog box my($info) = shift; my($message) = shift; my($amt); my($bit); my(@cmp); my($category); my($check); my($comment); my(@trans); # Set up the strings to put into the dialog box to ask the user @trans = split(/\t/, $info); # Fix up the date into the form MM/DD/YY (since it's always # a fixed size, we can just rearrange the digits) $trans[0] =~ s?..(..)(..)(..)?$2/$3/$1?; # Find out if amount is + or - $amt = sprintf("%.2f", ($trans[3] > 0) ? -$trans[3] : $trans[4]); # If we don't have a check #, comment, or category (since those are # optional), put $check = (length($trans[1])) ? $trans[1] : ""; $comment = (length($trans[6])) ? $trans[6] : ""; $category = (length($trans[5])) ? $trans[5] : ""; # Figure out which fields were compared for($bit = 0;$bit < 6;++$bit) { $cmp[$bit] = (($CBB::compare >> $bit) & 0x01) ? "*" : " "; } $$message .= "\"\n$cmp[0]Date: $trans[0]\" "; $$message .= "\"$cmp[1]Check #: $check\" "; $$message .= "\"$cmp[2]Description: $trans[2]\" "; $$message .= "\"$cmp[3]Amount: $amt\" "; $$message .= "\"$cmp[4]Comment: $comment\" "; $$message .= "\"$cmp[5]Category: $category\n\" "; } sub CompareTrans { # in: two transactions to compare for equality # out: 1 if equal, 0 if different my($trans1) = shift; my($trans2) = shift; my($cmp1); my($cmp2); # Retrieve fields to compare $cmp1 = &GetFields($trans1); $cmp2 = &GetFields($trans2); return(($cmp1 eq $cmp2) ? 1 : 0); } sub GetFields { # in: transaction # out: wanted fields of transaction my($trans) = shift; my($pos); my(@splitf); my(@fields); my($indx); # Split apart to get to separate fields @splitf = split(/\t/, $trans); # Retrieve fields to compare for($indx = $pos = 0;$indx < scalar(@splitf);++$indx, ++$pos) { # When indx == 3, this is a special case for the amount if ($indx != 3) { push(@fields, $splitf[$indx]) if ((1 << $pos) & $CBB::compare); } else { # We have to figure out which amount to get if we are # checking the amount field if ((1 << $pos) & $CBB::compare) { if ($splitf[$indx] > 0.0) { push(@fields, sprintf("%.2f", $splitf[$indx])); } else { push(@fields, sprintf("%.2f", $splitf[++$indx])); } } } } return(join(" ", @fields)); } sub ChangeKey { # in: date, count of key to modify my($date) = shift; my($count) = shift; # We'll change this key by seeing if a transaction exists with # a key of "count+1". If so, we call this routine again, and so # on recursively until we reach a "count+1" that is not assigned yet. ChangeKey($date, $count + 1) if($CBB::TRANS{"$date-".&pad($count + 1)}); $CBB::TRANS{"$date-".&pad($count + 1)} = $CBB::TRANS{"$date-".&pad($count)}; } sub CompareCheckNums { # in: two transactions # out: < 0, 0, > 0 depending on if the first transaction has a check number # less than, equal to, or greater than the check number of the 2nd # transaction my($trans1) = shift; my($trans2) = shift; my(@trans1); my(@trans2); # Split the transactions into parts to easily fetch the check numbers @trans1 = split(/\t/, $trans1); @trans2 = split(/\t/, $trans2); return($trans1[1] - $trans2[1]); } # set @CBB::KEYS = sorted list of transaction keys sub sort_keys { $CBB::sorted_keys = 1; $CBB::current = 0; print DEBUG "sort_keys()\n" if $CBB::debug; @CBB::KEYS = sort(keys %CBB::TRANS); } # recalculate the transactions sub calc_trans { my($total, $ntotal, $stotal, $ctotal) = (0.00, 0.00, 0.00, 0.00); my($count, $ncount, $scount, $ccount) = (0, 0, 0, 0); my($key); my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk); my($current_date) = &raw_date(); $CBB::calced = 1; print DEBUG "calc_trans()\n" if $CBB::debug; if ($CBB::sorted_keys == 0) { &sort_keys(); } $CBB::BALS{"Current"} = 0.00; foreach $key (@CBB::KEYS) { ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk) = split(/\t/, $CBB::TRANS{$key}); $total = $total + $credit - $debit; $count++; if ( $date <= $current_date ) { $CBB::BALS{"Current"} = $total; } if ( ($cleared eq "x") || ($cleared eq "X") ) { $ctotal = $ctotal + $credit - $debit; $ccount++; } elsif ( $cleared eq "*" ) { $stotal = $stotal + $credit - $debit; $scount++; } else { $ntotal = $ntotal + $credit - $debit; $ncount++; } $CBB::TRANS{$key} = "$date\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t". sprintf("%.2f", $total); } $CBB::BALS{"Amount"} = $total; $CBB::BALS{"Count"} = $count; $CBB::BALS{"Xamount"} = $ctotal; $CBB::BALS{"Xcount"} = $ccount; $CBB::BALS{"*amount"} = $stotal; $CBB::BALS{"*count"} = $scount; $CBB::BALS{"Namount"} = $ntotal; $CBB::BALS{"Ncount"} = $ncount; } # create a transaction (and add to the transaction list) sub create_trans { # in: transaction # out: keyed_transaction my($trans) = @_; my($key); $CBB::sorted_keys = 0; $CBB::calced = 0; &insert_and_update_mem($trans); my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = split(/\t/, $trans); if ( length($date) == 6 ) { # for backwards compatibility ... shouldn't be needed now. # year >= 80, 1900 ... year < 80, 2000 my($century) = (substr($date, 0, 2) lt '80' ? '20' : '19'); $date = "$century$date"; $trans = "$century$trans"; } $key = &get_next_key($date, $trans); if ($key) { $trans = "$date\t$check\t$desc\t$debit\t$credit\t$cat" . "\t$com\t$cleared\t$total"; $CBB::TRANS{$key} = "$trans"; print DEBUG "created: $key\t$trans\n" if $CBB::debug; return "$key\t$trans"; } else { return(undef); } } # create a transfer transaction in the current file and the transfer to file sub create_xfer { # in: transaction # out: keyed_transaction my($trans) = @_; my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = split(/\t/, $trans); my($orig_file) = $CBB::current_file; my($to_trans, $to_file, $from_cat); my($key, $result); my($returned_result); $CBB::sorted_keys = 0; $CBB::calced = 0; print DEBUG "(xfer) current_file = $CBB::current_file\n" if $CBB::debug; # determine the "from" category $from_cat = "[".&file_basename(&file_root($CBB::current_file))."]"; # determine the "to" file name $to_file = $cat; chop($to_file); $to_file = substr($to_file, 1); $to_file = &file_dirname($CBB::current_file)."/$to_file"; print DEBUG "to file = '$to_file' ($to_file.cbb)\n" if $CBB::debug; if ( -e "$to_file.cbb" ) { $to_file .= ".cbb"; } elsif ( -e "$to_file.dir" ) { $to_file .= ".dir"; } else { return "error"; } print DEBUG "Transfer to $to_file\n" if $CBB::debug; # create the "to" transaction. Note: future transfers (i.e. those # created by recur.pl are marked '-' for recur.pl processing if ( $cleared eq "?" ) { $to_trans = "$date\t$check\t$desc\t".$credit."\t".$debit."\t". $from_cat."\t$com\t-\t$total"; } else { $to_trans = "$date\t$check\t$desc\t".$credit."\t".$debit."\t". $from_cat."\t$com\t$cleared\t$total"; } # we need special handling here to preserve the .cbb file # save the current transactions to a temporary file # before loading the "to" account $result = &save_trans("$orig_file.$$.tmp"); return "error" if ( $result eq "error" ); %CBB::TRANS = (); # clear out any transactions from the current file # open the "to" account $result = &load_trans($to_file); return "error" if ( $result eq "error" ); $result = &create_trans($to_trans); $result = &save_trans($to_file); $result = &load_cbb_trans("$orig_file.$$.tmp"); return "error" if ( $result eq "error" ); unlink("$orig_file.$$.tmp"); $CBB::current_file = $orig_file; # create the "from" transaction $returned_result = &create_trans($trans); return "$returned_result"; } # update a transaction (replace in the transaction list) sub update_trans { # in: keyed_transaction # out: keyed_transaction my($keyed_trans) = @_; my($key, $trans, $result); $CBB::sorted_keys = 0; $CBB::calced = 0; ($key, $trans) = split(/\t/, $keyed_trans, 2); &delete_trans($key); $result = &create_trans($trans); print DEBUG "updated: $key\n" if $CBB::debug; print DEBUG " to: $result\n" if $CBB::debug; return "$result"; } # update a transfer transaction (replace in the transaction list) sub update_xfer { # in: keyed_transaction # out: keyed_transaction my($keyed_trans) = @_; my($key, $trans, $result); $CBB::sorted_keys = 0; $CBB::calced = 0; ($key, $trans) = split(/\t/, $keyed_trans, 2); &delete_xfer($key); $result = &create_xfer($trans); print DEBUG "updated: $key\n" if $CBB::debug; print DEBUG " to: $result\n" if $CBB::debug; return "$result"; } # delete a transaction given the key sub delete_trans { # in: key my($key) = @_; $CBB::sorted_keys = 0; $CBB::calced = 0; delete $CBB::TRANS{$key}; if ($CBB::current > 0) { --$CBB::current; } print DEBUG "deleted: $key\n" if $CBB::debug; return "ok"; } # delete an transfer transaction in the transfer to file sub delete_xfer { # in: key my($key) = @_; my($orig_file, $orig_current) = ($CBB::current_file, $CBB::current); my($count) = 0; my($to_file, $from_cat, $found_key, $found_trans); my($result); my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = split(/\t/, $CBB::TRANS{$key}); $CBB::sorted_keys = 0; $CBB::calced = 0; # determine the "from" category $from_cat = "[".&file_basename(&file_root($CBB::current_file))."]"; # determine the "to" file name $to_file = $cat; chop($to_file); $to_file = substr($to_file, 1); $to_file = &file_dirname($CBB::current_file)."/$to_file"; print DEBUG "to file = '$to_file' ($to_file.cbb)\n" if $CBB::debug; if ( -e "$to_file.cbb" ) { $to_file .= ".cbb"; } else { return "error"; } print DEBUG "Deleting transfer to $to_file\n" if $CBB::debug; # We need special handling here to preserve the .cbb file. Save # the current transactions to a temporary file before loading the # "to" account. $result = &save_trans("$orig_file.$$.tmp"); return "error" if ( $result eq "error" ); # open the "to" account $result = &load_trans($to_file); return "error" if ( $result eq "error" ); # now search for the transaction while ( $found_trans = $CBB::TRANS{"$date-".&pad($count)} ) { my($found_date, $found_check, $found_desc, $found_debit, $found_credit, $found_cat, $found_com, $found_cleared, $found_total) = split(/\t/, $found_trans); last if (($found_check eq $check) && ($found_desc eq $desc) && ($found_debit == $credit) && ($found_credit == $debit) && ($found_com eq $com) && ($found_cat eq $from_cat) && ($found_key = "$date-".&pad($count)) ); $count++; } print DEBUG "Found key: $found_key\n" if $CBB::debug; if ( $found_key ) { delete $CBB::TRANS{$found_key}; $CBB::calced = 0; $CBB::sorted_keys = 0; } else { print DEBUG "Transaction not found in $to_file\n" if $CBB::debug; } # now save the "to" account $result = &save_trans($to_file); # revert to orig account $result = &load_cbb_trans("$orig_file.$$.tmp"); return "error" if ( $result eq "error" ); unlink("$orig_file.$$.tmp"); # restore global variables $CBB::current_file = $orig_file; $CBB::current = $orig_current; $CBB::calced = 0; $CBB::sorted_keys = 0; delete $CBB::TRANS{$key}; if ($CBB::current > 0) { --$CBB::current; } print DEBUG "deleted: $key\n" if $CBB::debug; return "ok"; } # return the next transaction sub next_trans { my($trans); if ($CBB::sorted_keys == 0) { &sort_keys(); } if ($CBB::calced == 0) { &calc_trans(); } ++$CBB::current; $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]}; if ( $trans ) { return "$CBB::KEYS[$CBB::current]\t$trans"; } else { return "none"; } } # return the transaction specified by a key sub find_trans { # uses a binary search so that we can keep $CBB::current current. # Yeeeks! I have to think for a change. # Hmmm, maybe I should rethink my data structures ... nah. :) my($key) = @_; my($left, $middle, $right) = (0, 0, $#CBB::KEYS); my($trans); if ($CBB::sorted_keys == 0) { &sort_keys(); } if ($CBB::calced == 0) { &calc_trans(); } $trans = ""; while ( $left <= $right ) { $middle = int( ($left + $right) / 2 ); print DEBUG "$left < $middle < $right\n" if $CBB::debug; if ( $CBB::KEYS[$middle] lt $key ) { $left = $middle + 1; print DEBUG " left = middle + 1\n" if $CBB::debug; } elsif ( $CBB::KEYS[$middle] gt $key ) { $right = $middle - 1; print DEBUG " right = middle - 1\n" if $CBB::debug; } else { # we found it, set $trans to what we want and force an exit of # the while loop $trans = $CBB::TRANS{$CBB::KEYS[$middle]}; print DEBUG " found it: $trans\n" if $CBB::debug; $CBB::current = $middle; $left = $right + 1; } } print DEBUG "found: $key\t$trans\n" if $CBB::debug; if ( $trans ) { return "$key\t$trans"; } else { return "none"; } } # returns the current index sub get_current_index { return ($CBB::current + 1); } # return the first transaction sub first_trans { my($trans); if ($CBB::sorted_keys == 0) { &sort_keys(); } if ($CBB::calced == 0) { &calc_trans(); } $CBB::current = 0; $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]}; if ( $trans ) { return "$CBB::KEYS[$CBB::current]\t$trans"; } else { return "none"; } } # returns the entire transaction list in one big chunk. sub all_trans { # in: date # out: result my($date_fmt) = @_; my($key, $nicecat, $cutcom, $cutdesc, $cutcheck, $nicedate, $checklen); my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total); my($day, $month, $year); $| = 0; # turn off buffer flushing if ($CBB::calced == 0) { &calc_trans(); } if ($CBB::sorted_keys == 0) { &sort_keys(); } foreach $key (@CBB::KEYS) { # print ("$key\t$CBB::TRANS{$key}\n"); ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = split(/\t/, $CBB::TRANS{$key}); if ( length($date) == 6 ) { # for backwards compatibility ... shouldn't be needed now. ($year, $month, $day) = $date =~ /(\d\d)(\d\d)(\d\d)/; my($century) = ($year lt '80' ? '20' : '19'); $year = "$century$year"; } else { ($year, $month, $day) = $date =~ /(\d\d\d\d)(\d\d)(\d\d)/ } $checklen = length($check); if ( $checklen > 5 ) { $cutcheck = substr($check, $checklen - 5, 5); } else { $cutcheck = $check; } if ( $date_fmt == 1 ) { $nicedate = "$month/$day/$year"; } else { $nicedate = "$day.$month.$year"; } $cutdesc = substr($desc, 0, 15); $cutcom = substr($com, 0, 15); if ( $cat =~ m/\|/ ) { $nicecat = "-Splits-"; } else { $nicecat = $cat; } $nicecat = substr($nicecat, 0, 9); printf("%5s %-10s %-15s %9.2f %9.2f %-1s %10.2f %14s\n", $cutcheck, $nicedate, $cutdesc, $debit, $credit, $cleared, $total, $key); printf("%5s %-10s %-15s %-9s %39s\n", "", "", $cutcom, $nicecat, $key); } $| = 1; # turn buffer flushing back on return "none"; } # returns part of the transaction list in one big chunk. (since a date) sub part_trans { # in: date # out: result my($sdate_fmt) = @_; my($left, $middle, $right) = (0, 0, $#CBB::KEYS); my($date_fmt, $sdate); my($key, $nicecat, $cutcom, $cutdesc, $cutcheck, $nicedate, $checklen); my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total); my($day, $month, $year); # two arguments: data_format and start date ($date_fmt, $sdate) = split(" ", $sdate_fmt, 2); $| = 0; # turn off buffer flushing if ($CBB::calced == 0) { &calc_trans(); } if ($CBB::sorted_keys == 0) { &sort_keys(); } # look for first key past starting with sdate (borrowed from find_trans) $sdate = "$sdate-".&pad(0); while ( $left <= $right ) { $middle = int( ($left + $right) / 2 ); if ( $CBB::KEYS[$middle] lt $sdate ) { $left = $middle + 1; } elsif ( $CBB::KEYS[$middle] gt $sdate ) { $right = $middle - 1; } else { # we found it, force an exit of the while loop $left = $right + 1; } } if ($CBB::KEYS[$middle] != $sdate) { # we found the first past sdate $middle = $left; } for (; $middle <= $#CBB::KEYS ; ++$middle) { $key=$CBB::KEYS[$middle]; # print ("$key\t$CBB::TRANS{$key}\n"); ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = split(/\t/, $CBB::TRANS{$key}); if ( length($date) == 6 ) { # for backwards compatibility ... shouldn't be needed now. ($year, $month, $day) = $date =~ /(\d\d)(\d\d)(\d\d)/; my($century) = ($year lt '80' ? '20' : '19'); $year = "$century$year"; } else { ($year, $month, $day) = $date =~ /(\d\d\d\d)(\d\d)(\d\d)/ } $checklen = length($check); if ( $checklen > 5 ) { $cutcheck = substr($check, $checklen - 5, 5); } else { $cutcheck = $check; } if ( $date_fmt == 1 ) { $nicedate = "$month/$day/$year"; } else { $nicedate = "$day.$month.$year"; } $cutdesc = substr($desc, 0, 15); $cutcom = substr($com, 0, 15); if ( $cat =~ m/\|/ ) { $nicecat = "-Splits-"; } else { $nicecat = $cat; } $nicecat = substr($nicecat, 0, 9); printf("%5s %-10s %-15s %9.2f %9.2f %-1s %10.2f %14s\n", $cutcheck, $nicedate, $cutdesc, $debit, $credit, $cleared, $total, $key); printf("%5s %-10s %-15s %-9s %39s\n", "", "", $cutcom, $nicecat, $key); } $| = 1; # turn buffer flushing back on return "none"; } # return the first uncleared transaction sub first_uncleared_trans { my($trans); my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk); if ($CBB::sorted_keys == 0) { &sort_keys(); } if ($CBB::calced == 0) { &calc_trans(); } $CBB::current = 0; $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]}; ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk) = split(/\t/, $trans); while ( ($cleared eq "x") || ($cleared eq "X") ) { ++$CBB::current; $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]}; ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk) = split(/\t/, $trans); } if ( $trans ) { return "$CBB::KEYS[$CBB::current]\t$trans"; } else { return "none"; } } # return the next uncleared transaction sub next_uncleared_trans { my($trans); my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk); if ($CBB::sorted_keys == 0) { &sort_keys(); } if ($CBB::calced == 0) { &calc_trans(); } ++$CBB::current; $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]}; ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk) = split(/\t/, $trans); while ( ($cleared eq "x") || ($cleared eq "X") ) { ++$CBB::current; $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]}; ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk) = split(/\t/, $trans); } if ( $trans ) { return "$CBB::KEYS[$CBB::current]\t$trans"; } else { return "none"; } } # select transaction -- primes a transaction for future clearing sub select_trans { # in: key # out: keyed_transaction my($key) = @_; my($trans); my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total); $CBB::sorted_keys = 0; $CBB::calced = 0; $trans = $CBB::TRANS{$key}; ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = split(/\t/, $trans); $cleared = "*"; $CBB::TRANS{$key} = "$date\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t$total"; print DEBUG "selected: $key to be cleared\n" if $CBB::debug; return "$key\t$CBB::TRANS{$key}"; } # select transaction -- primes a transaction for future clearing sub unselect_trans { # in: key # out: keyed_transaction my($key) = @_; my($trans); my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total); $CBB::sorted_keys = 0; $CBB::calced = 0; $trans = $CBB::TRANS{$key}; ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = split(/\t/, $trans); $cleared = ""; $CBB::TRANS{$key} = "$date\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t$total"; print DEBUG "unselected: $key will not be cleared\n" if $CBB::debug; return "$key\t$CBB::TRANS{$key}"; } # clear all selected transactions sub clear_trans { my($key, $trans); my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total); if ($CBB::calced == 0) { &calc_trans(); } if ($CBB::sorted_keys == 0) { &sort_keys(); } foreach $key (@CBB::KEYS) { $trans = $CBB::TRANS{$key}; ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = split(/\t/, $trans); if ( $cleared eq "*" ) { $cleared = "x"; $CBB::TRANS{$key} = "$date\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t$total"; } } } # return the cleared balance (this should be the last statement ending bal) sub get_cleared_bal { return sprintf("%.2f", $CBB::BALS{"Xamount"}); } # initialize the transactions data structure sub init_trans { # out: result $CBB::sorted_keys = 0; $CBB::calced = 0; @CBB::KEYS = (); return "ok"; } # make a new account sub make_acct { # in: acct-name acct-desc acct-type # out: result my($name, $desc) = split(/ /, $_[0], 2); my($pos, $short_name); print DEBUG "Make account $name - $desc\n" if $CBB::debug; # print "Make account $name - $desc\n"; print DEBUG "Making cbb account\n" if $CBB::debug; open(SAVE, ">$name.cbb.new"); close(SAVE); unlink("$name.cbb.bak"); rename("$name.cbb", "$name.cbb.bak"); rename("$name.cbb.new", "$name.cbb"); $CBB::current_file = "$name.cbb"; %CBB::TRANS = (); # Assume we have category already open ... :| ??? :( # strip leading path from $name &insert_cat("[".&file_basename($name)."]\t$desc\t"); # save the categories file before it gets toasted &save_cats(&file_dirname($name) . "/categories"); return "ok"; } # determine the file type and call the correct load routine sub load_trans { # in: file base # out: result my($file) = @_; my($ext) = &file_extension($file); # print "$ext\n"; # print &file_root($file) . "\n"; print DEBUG "file extension is: $ext\n" if $CBB::debug; if ($CBB::cache) { no strict 'vars'; # necessary for this special hack no strict 'refs'; # save current data to cache my($hname) = "ACC_" . &file_basename($CBB::current_file); print DEBUG "$hname $CBB::current_file\n" if $CBB::debug; %$hname = %CBB::TRANS; # test if new table already in cache $hname = "ACC_" . &file_basename($file); print DEBUG "$hname\n" if $CBB::debug; if (scalar (%$hname) ) { print DEBUG "$hname defined , load from cache\n" if $CBB::debug; $CBB::sorted_keys = 0; $CBB::calced = 0; %CBB::TRANS = %$hname; # take values from the cache &calc_trans(); $CBB::current_file = $file; return "ok"; } } return &load_cbb_trans($file); } # load the data from a cbb file sub load_cbb_trans { # in: file name (including .cbb extension) # out: result my($file) = @_; my($file_version) = ""; my($junk); $CBB::sorted_keys = 0; $CBB::calced = 0; print DEBUG "Loading the cbb format file: $file\n" if $CBB::debug; if ( $CBB::decrypt ne "" ) { open(LOAD, "$CBB::decrypt < $file|") || return "error"; } else { open(LOAD, "<$file") || return "error"; } %CBB::TRANS = (); # clear out any transactions from the previous file while ( ) { if ( m/^#/ ) { # toss the comment (but first check for any goodies.) if ( m/version/i ) { ($junk, $junk, $junk, $file_version) = split; print DEBUG "Data file version = $file_version\n" if $CBB::debug; } } else { if ( $file_version eq "") { print DEBUG "no data file version, file encrypted ?" if $CBB::debug; close(LOAD); return "error"; } chop; if ( ! m/\t/ ) { s/:/\t/g; $_ = &fix_splits($_); } &create_trans($_); } } close(LOAD); &calc_trans(); $CBB::current_file = $file; return "ok"; } sub fix_splits { # in: transaction with old two field per record splits # out: transaction with new three field per record splits my($line) = @_; my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = split(/\t/, $line); my(@cats, $i, $max, $newcat); if ( $cat =~ m/\|/ ) { @cats = split(/\|/, $cat); $i = 0; $max = ($#cats - 1) / 2; $newcat = "|"; while ( $i < $max ) { $newcat .= $cats[$i * 2 + 1] . "||" . $cats[$i * 2 + 2] . "|"; $i++; } } else { $newcat = $cat; } return "$date\t$check\t$desc\t$debit\t$credit\t$newcat\t$com\t$cleared\t$total"; } # load the data from a dbm file sub load_dbm_trans { # in: file base name # out: result my($file) = @_; print DEBUG "Loading the dbm format file: $file\n" if $CBB::debug; if ( -e "$file" ) { $CBB::current_file = $file; $CBB::sorted_keys = 0; $CBB::calced = 0; dbmclose(%CBB::TRANS); dbmopen(%CBB::TRANS, &file_root($file), 0666) || return "error"; # test to see if this file is delimited &sort_keys(); # never ever call calc_trans() at this point (or call something that # calls it if (defined($CBB::TRANS{$CBB::KEYS[0]}) && !($CBB::TRANS{$CBB::KEYS[0]} =~ m/\t/) ) { print DEBUG "'$CBB::TRANS{$CBB::KEYS[0]}' = old version of CBB dbm file\n" if $CBB::debug; return "error - old version of CBB dbm file"; } else { print DEBUG "valid txn: '$CBB::TRANS{$CBB::KEYS[0]}'\n" if $CBB::debug; } return "ok"; } else { return "error"; } } # save all the precious data to a file sub save_trans { # in: file name (including .cbb extension) # out: result my($file) = @_; my($auto_save_file, $key); my(@trans); my($file_exists) = 0; my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks); print DEBUG "Saving the cbb format file: $file\n" if $CBB::debug; if ($CBB::calced == 0) { &calc_trans(); } if ($CBB::sorted_keys == 0) { &sort_keys(); } if ( $CBB::encrypt ne "" ) { open(SAVE, "|$CBB::encrypt > $file.new") || return "error"; } else { open(SAVE, ">$file.new") || return "error"; } # Print some header stuff print (SAVE "# CBB Data File -- $file\n"); print (SAVE "#\n"); print (SAVE "# CBB Version = $CBB::version_num\n"); printf (SAVE "# Current Balance = %.2f\n", $CBB::BALS{Current}); printf (SAVE "# Ending Balance = %.2f\n", $CBB::BALS{Amount}); print (SAVE "# Transaction Count = $CBB::BALS{Count}\n"); printf (SAVE "# Cleared Balance = %.2f\n", $CBB::BALS{Xamount}); print (SAVE "# Cleared Txn Count = $CBB::BALS{Xcount}\n"); print (SAVE "# Saved on (US Date Fmt) " . &nice_date("1") . " "); print (SAVE "by $CBB::user_name\n"); print (SAVE "#\n"); print (SAVE "# date check desc debit credit cat com cleared\n"); print (SAVE "# ---------------------------------------------------\n"); foreach $key (@CBB::KEYS) { # strip off last total @trans = split(/\t/, $CBB::TRANS{$key}); print SAVE join ("\t", @trans[0..7]) . "\n"; } close(SAVE); # preserve file permissions if the file exists if ( -e $file ) { $file_exists = 1; ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat($file); print DEBUG "file permissions = $mode\n" if $CBB::debug; print DEBUG "file owner = $uid group = $gid\n" if $CBB::debug; } if ( $file_exists ) { unlink("$file.bak"); rename("$file", "$file.bak"); } rename("$file.new", "$file"); if ( $file_exists ) { chown($uid, $gid, $file); chmod($mode, $file); } $auto_save_file = &file_dirname($file) . "#" . &file_basename($file) . "#"; print DEBUG "auto_save_file = $auto_save_file\n" if $CBB::debug; if ( -e $auto_save_file ) { unlink("$auto_save_file"); unlink("$auto_save_file.bak"); } return "ok"; } 1;