home *** CD-ROM | disk | FTP | other *** search
/ Chip: Linux Special / CorelLinux_CHIP.iso / live / usr / X11R6 / lib / X11 / cbb / engine.pl < prev    next >
Encoding:
Perl Script  |  1998-10-07  |  31.4 KB  |  1,230 lines
  1. #!/usr/bin/perl
  2. #  engine.pl - the CBB 'engine'.
  3. #              This script implements a transaction abstract data type
  4. #              It encapsulates a list a transactions and the functions
  5. #              required to manipulate the transactions.
  6. #
  7. #  Written by Curtis Olson.  Started August 22, 1994.
  8. #
  9. #  Copyright (C) 1994 - 1997  Curtis L. Olson  - curt@sledge.mn.org
  10. #
  11. #  This program is free software; you can redistribute it and/or modify
  12. #  it under the terms of the GNU General Public License as published by
  13. #  the Free Software Foundation; either version 2 of the License, or
  14. #  (at your option) any later version.
  15. #
  16. #  This program is distributed in the hope that it will be useful,
  17. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. #  GNU General Public License for more details.
  20. #
  21. #  You should have received a copy of the GNU General Public License
  22. #  along with this program; if not, write to the Free Software
  23. #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  
  25. # $Id: engine.pl,v 2.20 1998/08/14 14:30:11 curt Exp $
  26. # (Log is kept at end of this file)
  27.  
  28.  
  29. package CBB;
  30.  
  31. use strict;   # don't take no guff
  32.  
  33.  
  34. # @INC specifies the installed location of the necessary pieces.
  35. # It should already be setup by wrapper.pl
  36.  
  37. require "common.pl";
  38. require "log.pl";
  39.  
  40.  
  41. $| = 1;                # flush buffers after every write
  42.  
  43. if ( $CBB::logging != 0 && $CBB::logging != 1) {
  44.     # if not specified elsewhere, turn on logging
  45.     $CBB::logging = 1;            # 0 = off,  1 = on
  46. }
  47.  
  48. if ( $CBB::debug != 0 && $CBB::debug != 1) {
  49.     # if not specified elsewhere, turn off debugging.
  50.     $CBB::debug = 0;            # 0 = off,  1 = on
  51. }
  52.  
  53. # Global variables
  54.  
  55. # %CBB::TRANS - an associative array of transactions and transaction keys
  56. # @CBB::KEYS - a sorted list of transaction keys (for traversing the trans list)
  57. # $CBB::sorted_keys - specifies whether the list in @CBB::KEYS is valid
  58. # $CBB::calced - specified whether the transactions have been properly calculated
  59. # $CBB::current - specifies the "current" position in the @CBB::KEYS array
  60. # $CBB::current_file - full name of currently opened transaction file
  61. # %CBB::BALS - an associative array used to store account information
  62. # $CBB::version - version number (set in common.pl)
  63.  
  64.  
  65. &init_trans();           # initialize %CBB::TRANS, @CBB::KEYS, and $CBB::sorted_keys
  66. open(DEBUG, ">debug") if $CBB::debug;
  67.  
  68.  
  69. # toggle debugging
  70. sub debug {
  71.     # in: flag
  72.     # out: flag
  73.  
  74.     my($newdebug) = @_;
  75.  
  76.     if ($newdebug == 1) {
  77.     # turning debugging on
  78.  
  79.     if ($CBB::debug == 1) {
  80.         # already on, do nothing
  81.     } else {
  82.         $CBB::debug = 1;
  83.         open(DEBUG, ">debug");
  84.     }
  85.     } else {
  86.     # turning of debugging
  87.  
  88.     if ($CBB::debug == 0) {
  89.         # already off, do nothing
  90.     } else {
  91.         $CBB::debug = 0;
  92.         close(DEBUG);
  93.     }
  94.     }
  95.  
  96.     return $CBB::debug;
  97. }
  98.   
  99.  
  100. # get next available key for a specified date
  101. sub get_next_key {
  102.     # in: date
  103.     # out: key
  104.  
  105.     my($date) = @_;
  106.     my($count) = 0;
  107.  
  108.     while ( $CBB::TRANS{"$date-".&pad($count)} ) {
  109.     $count++;
  110.     }
  111.  
  112.     return "$date-".&pad($count);
  113. }
  114.  
  115.  
  116. # set @CBB::KEYS = sorted list of transaction keys
  117. sub sort_keys {
  118.     $CBB::sorted_keys = 1;
  119.     $CBB::current = 0;
  120.  
  121.     print DEBUG "sort_keys()\n" if $CBB::debug;
  122.     @CBB::KEYS = sort(keys %CBB::TRANS);
  123. }
  124.  
  125.  
  126. # recalculate the transactions
  127. sub calc_trans {
  128.     my($total, $ntotal, $stotal, $ctotal) = (0.00, 0.00, 0.00, 0.00);
  129.     my($count, $ncount, $scount, $ccount) = (0, 0, 0, 0);
  130.     my($key);
  131.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk);
  132.  
  133.     my($current_date) = &raw_date();
  134.     
  135.     $CBB::calced = 1;
  136.  
  137.     print DEBUG "calc_trans()\n" if $CBB::debug;
  138.  
  139.     if ($CBB::sorted_keys == 0) {
  140.     &sort_keys();
  141.     }
  142.  
  143.     $CBB::BALS{"Current"} = 0.00;
  144.  
  145.     foreach $key (@CBB::KEYS) {
  146.         ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, 
  147.             $junk) = split(/\t/, $CBB::TRANS{$key});
  148.  
  149.     $total = $total + $credit - $debit;
  150.     $count++;
  151.  
  152.     if ( $date <= $current_date ) {
  153.         $CBB::BALS{"Current"} = $total;
  154.     }
  155.  
  156.     if ( ($cleared eq "x") || ($cleared eq "X") ) {
  157.         $ctotal = $ctotal + $credit - $debit;
  158.         $ccount++;
  159.     } elsif ( $cleared eq "*" ) {
  160.         $stotal = $stotal + $credit - $debit;
  161.         $scount++;
  162.     } else {
  163.         $ntotal = $ntotal + $credit - $debit;
  164.         $ncount++;
  165.     }
  166.  
  167.     $CBB::TRANS{$key} = 
  168.       "$date\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t".
  169.           sprintf("%.2f", $total);
  170.     }
  171.  
  172.     $CBB::BALS{"Amount"} =  $total;
  173.     $CBB::BALS{"Count"} =   $count;
  174.  
  175.     $CBB::BALS{"Xamount"} = $ctotal;
  176.     $CBB::BALS{"Xcount"} =  $ccount;
  177.  
  178.     $CBB::BALS{"*amount"} = $stotal;
  179.     $CBB::BALS{"*count"} =  $scount;
  180.  
  181.     $CBB::BALS{"Namount"} = $ntotal;
  182.     $CBB::BALS{"Ncount"} =  $ncount;
  183. }
  184.  
  185.  
  186. # create a transaction (and add to the transaction list)
  187. sub create_trans {
  188.     # in: transaction
  189.     # out: keyed_transaction
  190.  
  191.     my($trans) = @_;
  192.     my($key);
  193.  
  194.     $CBB::sorted_keys = 0;
  195.     $CBB::calced = 0;
  196.  
  197.     &insert_and_update_mem($trans);
  198.  
  199.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) =
  200.     split(/\t/, $trans);
  201.  
  202.     if ( length($date) == 6 ) {
  203.     # for backwards compatibility ... shouldn't be needed now.
  204.     $date = "19$date";
  205.     }
  206.  
  207.     $key = &get_next_key($date);
  208.  
  209.     $trans = "$date\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t$total";
  210.  
  211.     $CBB::TRANS{$key} = "$trans";
  212.  
  213.     print DEBUG "created:  $key\t$trans\n" if $CBB::debug;
  214.  
  215.     return "$key\t$trans";
  216. }
  217.  
  218.  
  219. # create a transfer transaction in the current file and the transfer to file
  220. sub create_xfer {
  221.     # in: transaction
  222.     # out: keyed_transaction
  223.  
  224.     my($trans) = @_;
  225.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) =
  226.     split(/\t/, $trans);    
  227.     my($orig_file) = $CBB::current_file;
  228.     my($to_trans, $to_file, $from_cat);
  229.     my($key, $result);
  230.     my($returned_result);
  231.  
  232.     $CBB::sorted_keys = 0;
  233.     $CBB::calced = 0;
  234.  
  235.     print DEBUG "(xfer) current_file = $CBB::current_file\n" if $CBB::debug;
  236.     # determine the "from" category
  237.     $from_cat = "[".&file_basename(&file_root($CBB::current_file))."]";
  238.  
  239.     # determine the "to" file name
  240.     $to_file = $cat;
  241.     chop($to_file);
  242.     $to_file = substr($to_file, 1);
  243.     $to_file = &file_dirname($CBB::current_file)."/$to_file";
  244.     print DEBUG "to file = '$to_file' ($to_file.cbb)\n" if $CBB::debug;
  245.     if ( -e "$to_file.cbb" ) {
  246.     $to_file .= ".cbb";
  247.     } elsif ( -e "$to_file.dir" ) {
  248.     $to_file .= ".dir";
  249.     } else {
  250.     return "error";
  251.     }
  252.  
  253.     print DEBUG "Transfer to $to_file\n" if $CBB::debug;
  254.  
  255.     # create the "to" transaction
  256.     $to_trans = "$date\t$check\t$desc\t".$credit."\t".$debit."\t".
  257.         $from_cat."\t$com\t$cleared\t$total";
  258.  
  259.     # we need special handling here to preserve the .cbb file
  260.     # save the current transactions to a temporary file
  261.     # before loading the "to" account
  262.     $result = &save_trans("$orig_file.$$.tmp");
  263.     return "error" if ( $result eq "error" );
  264.     %CBB::TRANS = ();  # clear out any transactions from the current file
  265.  
  266.     # open the "to" account
  267.     $result = &load_trans($to_file);
  268.     return "error" if ( $result eq "error" );
  269.     
  270.     $result = &create_trans($to_trans);
  271.     
  272.     $result = &save_trans($to_file);
  273.  
  274.     $result = &load_cbb_trans("$orig_file.$$.tmp");
  275.     return "error" if ( $result eq "error" );
  276.     unlink("$orig_file.$$.tmp");
  277.     $CBB::current_file = $orig_file;
  278.  
  279.     # create the "from" transaction
  280.     $returned_result = &create_trans($trans);
  281.  
  282.     return "$returned_result";
  283. }
  284.  
  285.  
  286. # update a transaction (replace in the transaction list)
  287. sub update_trans {
  288.     # in: keyed_transaction
  289.     # out: keyed_transaction
  290.  
  291.     my($keyed_trans) = @_;
  292.     my($key, $trans, $result);
  293.  
  294.     $CBB::sorted_keys = 0;
  295.     $CBB::calced = 0;
  296.  
  297.     ($key, $trans) = split(/\t/, $keyed_trans, 2);
  298.  
  299.     &delete_trans($key);
  300.     $result = &create_trans($trans);
  301.  
  302.     print DEBUG "updated:  $key\n" if $CBB::debug;
  303.     print DEBUG "     to:  $result\n" if $CBB::debug;
  304.  
  305.     return "$result";
  306. }
  307.  
  308.  
  309. # update a transfer transaction (replace in the transaction list)
  310. sub update_xfer {
  311.     # in: keyed_transaction
  312.     # out: keyed_transaction
  313.  
  314.     my($keyed_trans) = @_;
  315.     my($key, $trans, $result);
  316.  
  317.     $CBB::sorted_keys = 0;
  318.     $CBB::calced = 0;
  319.  
  320.     ($key, $trans) = split(/\t/, $keyed_trans, 2);
  321.  
  322.     &delete_xfer($key);
  323.     $result = &create_xfer($trans);
  324.  
  325.     print DEBUG "updated:  $key\n" if $CBB::debug;
  326.     print DEBUG "     to:  $result\n" if $CBB::debug;
  327.  
  328.     return "$result";
  329. }
  330.  
  331.  
  332. # delete a transaction given the key
  333. sub delete_trans {
  334.     # in: key
  335.  
  336.     my($key) = @_;
  337.     $CBB::sorted_keys = 0;
  338.     $CBB::calced = 0;
  339.  
  340.     delete $CBB::TRANS{$key};
  341.  
  342.     if ($CBB::current > 0) {
  343.     --$CBB::current;
  344.     }
  345.  
  346.     print DEBUG "deleted:  $key\n" if $CBB::debug;
  347.  
  348.     return "ok";
  349. }
  350.  
  351. # delete an transfer transaction in the transfer to file
  352. sub delete_xfer {
  353.     # in: key
  354.  
  355.     my($key) = @_;
  356.     my($orig_file, $orig_current) = ($CBB::current_file, $CBB::current);
  357.     my($count) = 0;
  358.  
  359.     my($to_file, $from_cat, $found_key, $found_trans);
  360.     my($result);
  361.  
  362.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) 
  363.     = split(/\t/, $CBB::TRANS{$key});
  364.  
  365.     $CBB::sorted_keys = 0;
  366.     $CBB::calced = 0;
  367.  
  368.     # determine the "from" category
  369.     $from_cat = "[".&file_basename(&file_root($CBB::current_file))."]";
  370.  
  371.     # determine the "to" file name
  372.     $to_file = $cat;
  373.     chop($to_file);
  374.     $to_file = substr($to_file, 1);
  375.     $to_file = &file_dirname($CBB::current_file)."/$to_file";
  376.     print DEBUG "to file = '$to_file' ($to_file.cbb)\n" if $CBB::debug;
  377.     if ( -e "$to_file.cbb" ) {
  378.     $to_file .= ".cbb";
  379.     } else {
  380.     return "error";
  381.     }
  382.  
  383.     print DEBUG "Deleting transfer to $to_file\n" if $CBB::debug;
  384.  
  385.     # We need special handling here to preserve the .cbb file.  Save
  386.     # the current transactions to a temporary file before loading the
  387.     # "to" account.
  388.     $result = &save_trans("$orig_file.$$.tmp");
  389.     return "error" if ( $result eq "error" );
  390.     
  391.     # open the "to" account
  392.     $result = &load_trans($to_file);
  393.     return "error" if ( $result eq "error" );
  394.  
  395.     # now search for the transaction
  396.     while ( $found_trans = $CBB::TRANS{"$date-".&pad($count)} ) {
  397.     my($found_date, $found_check, $found_desc, $found_debit, 
  398.           $found_credit, $found_cat, $found_com, $found_cleared, 
  399.           $found_total) = split(/\t/, $found_trans);
  400.  
  401.     last if (($found_check eq $check) && 
  402.          ($found_desc eq $desc) &&
  403.          ($found_debit == $credit) && 
  404.          ($found_credit == $debit) &&
  405.          ($found_com eq $com) && 
  406.          ($found_cat eq $from_cat) && 
  407.          ($found_key = "$date-".&pad($count)) );
  408.  
  409.     $count++;
  410.     }
  411.  
  412.     print DEBUG "Found key: $found_key\n" if $CBB::debug;
  413.  
  414.     if ( $found_key ) {
  415.     delete $CBB::TRANS{$found_key};
  416.     
  417.     $CBB::calced = 0;
  418.     $CBB::sorted_keys = 0;
  419.     } else {
  420.     print DEBUG "Transaction not found in $to_file\n" if $CBB::debug;
  421.     }
  422.  
  423.     # now save the "to" account
  424.     $result = &save_trans($to_file);
  425.  
  426.     # revert to orig account
  427.     $result = &load_cbb_trans("$orig_file.$$.tmp");
  428.     return "error" if ( $result eq "error" );
  429.     unlink("$orig_file.$$.tmp");
  430.  
  431.     # restore global variables
  432.     $CBB::current_file = $orig_file;
  433.     $CBB::current = $orig_current;
  434.     $CBB::calced = 0;
  435.     $CBB::sorted_keys = 0;
  436.  
  437.     delete $CBB::TRANS{$key};
  438.  
  439.     if ($CBB::current > 0) {
  440.     --$CBB::current;
  441.     }
  442.  
  443.     print DEBUG "deleted:  $key\n" if $CBB::debug;
  444.  
  445.     return "ok";
  446. }
  447.  
  448.  
  449. # return the next transaction
  450. sub next_trans {
  451.     my($trans);
  452.  
  453.     if ($CBB::sorted_keys == 0) {
  454.     &sort_keys();
  455.     }
  456.  
  457.     if ($CBB::calced == 0) {
  458.     &calc_trans();
  459.     }
  460.  
  461.     ++$CBB::current;
  462.     $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]};
  463.     if ( $trans ) {
  464.         return "$CBB::KEYS[$CBB::current]\t$trans";
  465.     } else {
  466.         return "none";
  467.     }
  468. }
  469.  
  470.  
  471. # return the transaction specified by a key
  472. sub find_trans {
  473.     # uses a binary search so that we can keep $CBB::current current.   
  474.     # Yeeeks! I have to think for a change.
  475.     # Hmmm, maybe I should rethink my data structures ... nah. :)
  476.  
  477.     my($key) = @_;
  478.     my($left, $middle, $right) = (0, 0, $#CBB::KEYS);
  479.     my($trans);
  480.  
  481.     if ($CBB::sorted_keys == 0) {
  482.     &sort_keys();
  483.     }
  484.  
  485.     if ($CBB::calced == 0) {
  486.     &calc_trans();
  487.     }
  488.  
  489.     $trans = "";
  490.  
  491.     while ( $left <= $right ) {
  492.     $middle = int( ($left + $right) / 2 );
  493.         print DEBUG "$left < $middle < $right\n" if $CBB::debug;
  494.     if ( $CBB::KEYS[$middle] lt $key ) {
  495.         $left = $middle + 1;
  496.         print DEBUG "  left = middle + 1\n" if $CBB::debug;
  497.         } elsif ( $CBB::KEYS[$middle] gt $key ) {
  498.         $right = $middle - 1;
  499.         print DEBUG "  right = middle - 1\n" if $CBB::debug;
  500.         } else {
  501.         # we found it, set $trans to what we want and force an exit of
  502.         # the while loop
  503.         $trans = $CBB::TRANS{$CBB::KEYS[$middle]};
  504.         print DEBUG "  found it: $trans\n" if $CBB::debug;
  505.         $CBB::current = $middle;
  506.         $left = $right + 1;
  507.         }
  508.     }
  509.  
  510.     print DEBUG "found:  $key\t$trans\n" if $CBB::debug;
  511.  
  512.     if ( $trans ) {
  513.         return "$key\t$trans";
  514.     } else {
  515.         return "none";
  516.     }
  517. }
  518.  
  519.  
  520. # returns the current index
  521. sub get_current_index {
  522.     return ($CBB::current + 1);
  523. }
  524.  
  525.  
  526. # return the first transaction
  527. sub first_trans {
  528.     my($trans);
  529.  
  530.     if ($CBB::sorted_keys == 0) {
  531.     &sort_keys();
  532.     }
  533.  
  534.     if ($CBB::calced == 0) {
  535.     &calc_trans();
  536.     }
  537.  
  538.     $CBB::current = 0;
  539.     $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]};
  540.     if ( $trans ) {
  541.         return "$CBB::KEYS[$CBB::current]\t$trans";
  542.     } else {
  543.         return "none";
  544.     }
  545. }
  546.  
  547.  
  548. # returns the entire transaction list in one big chunk.
  549. sub all_trans {
  550.     # in: date
  551.     # out: result
  552.  
  553.     my($date_fmt) = @_;
  554.     my($key, $nicecat, $cutcom, $cutdesc, $cutcheck, $nicedate, $checklen);
  555.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total);
  556.     my($day, $month, $year);
  557.  
  558.     $| = 0;                # turn off buffer flushing
  559.  
  560.     if ($CBB::calced == 0) {
  561.     &calc_trans();
  562.     }
  563.  
  564.     if ($CBB::sorted_keys == 0) {
  565.     &sort_keys();
  566.     }
  567.  
  568.     foreach $key (@CBB::KEYS) {
  569.     # print ("$key\t$CBB::TRANS{$key}\n");
  570.         ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) =
  571.         split(/\t/, $CBB::TRANS{$key});
  572.  
  573.         if ( length($date) == 6 ) {
  574.         # for backwards compatibility ... shouldn't be needed now.
  575.             ($year, $month, $day) = $date =~ /(\d\d)(\d\d)(\d\d)/;
  576.         $year = "19" . $year;
  577.         } else {
  578.             ($year, $month, $day) = $date =~ /(\d\d\d\d)(\d\d)(\d\d)/
  579.         }
  580.  
  581.         $checklen = length($check);
  582.         if ( $checklen > 5 ) {
  583.             $cutcheck = substr($check, $checklen - 5, 5);
  584.         } else {
  585.             $cutcheck = $check;
  586.         }
  587.  
  588.         if ( $date_fmt == 1 ) {
  589.             $nicedate = "$month/$day/" . substr($year, 2, 2);
  590.         } else {
  591.             $nicedate = "$day.$month." . substr($year, 2, 2);
  592.         }
  593.  
  594.         $cutdesc = substr($desc, 0, 15);
  595.         $cutcom = substr($com, 0, 15);
  596.         if ( $cat =~ m/\|/ ) {
  597.             $nicecat = "-Splits-";
  598.         } else {
  599.             $nicecat = $cat;
  600.         }
  601.     $nicecat = substr($nicecat, 0, 9);
  602.  
  603.     printf("%5s  %-8s  %-15s  %9.2f  %9.2f  %-1s %10.2f %14s\n",
  604.            $cutcheck, $nicedate, $cutdesc, $debit, $credit, $cleared, 
  605.            $total, $key);
  606.         printf("%5s  %-8s  %-15s  %-9s %39s\n", "", "", $cutcom, $nicecat, 
  607.            $key);
  608.     }
  609.  
  610.     $| = 1;                # turn buffer flushing back on
  611.  
  612.     return "none";
  613. }
  614.  
  615. # returns part of the transaction list in one big chunk. (since a date)
  616. sub part_trans {
  617.     # in: date
  618.     # out: result
  619.  
  620.     my($sdate_fmt) = @_;
  621.     my($left, $middle, $right) = (0, 0, $#CBB::KEYS);
  622.     my($date_fmt, $sdate);
  623.     my($key, $nicecat, $cutcom, $cutdesc, $cutcheck, $nicedate, $checklen);
  624.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total);
  625.     my($day, $month, $year);
  626.  
  627.     # two arguments: data_format and start date
  628.     ($date_fmt, $sdate) = split(" ", $sdate_fmt, 2);
  629.  
  630.     $| = 0;                # turn off buffer flushing
  631.  
  632.     if ($CBB::calced == 0) {
  633.     &calc_trans();
  634.     }
  635.  
  636.     if ($CBB::sorted_keys == 0) {
  637.     &sort_keys();
  638.     }
  639.  
  640.     # look for first key past starting with sdate (borrowed from find_trans)
  641.     $sdate = "$sdate-".&pad(0);
  642.  
  643.     while ( $left <= $right ) {
  644.     $middle = int( ($left + $right) / 2 );
  645.     if ( $CBB::KEYS[$middle] lt $sdate ) {
  646.         $left = $middle + 1;
  647.         } elsif ( $CBB::KEYS[$middle] gt $sdate ) {
  648.         $right = $middle - 1;
  649.         } else {
  650.         # we found it, force an exit of the while loop
  651.         $left = $right + 1;
  652.         }
  653.     }
  654.     if ($CBB::KEYS[$middle] != $sdate) {
  655.      # we found the first past sdate
  656.      $middle = $left;
  657.     }
  658.  
  659.     for (; $middle <= $#CBB::KEYS ; ++$middle) {
  660.     $key=$CBB::KEYS[$middle];
  661.  
  662.     # print ("$key\t$CBB::TRANS{$key}\n");
  663.         ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) =
  664.         split(/\t/, $CBB::TRANS{$key});
  665.  
  666.         if ( length($date) == 6 ) {
  667.         # for backwards compatibility ... shouldn't be needed now.
  668.             ($year, $month, $day) = $date =~ /(\d\d)(\d\d)(\d\d)/;
  669.         $year = "19" . $year;
  670.         } else {
  671.             ($year, $month, $day) = $date =~ /(\d\d\d\d)(\d\d)(\d\d)/
  672.         }
  673.  
  674.         $checklen = length($check);
  675.         if ( $checklen > 5 ) {
  676.             $cutcheck = substr($check, $checklen - 5, 5);
  677.         } else {
  678.             $cutcheck = $check;
  679.         }
  680.  
  681.         if ( $date_fmt == 1 ) {
  682.             $nicedate = "$month/$day/" . substr($year, 2, 2);
  683.         } else {
  684.             $nicedate = "$day.$month." . substr($year, 2, 2);
  685.         }
  686.  
  687.         $cutdesc = substr($desc, 0, 15);
  688.         $cutcom = substr($com, 0, 15);
  689.         if ( $cat =~ m/\|/ ) {
  690.             $nicecat = "-Splits-";
  691.         } else {
  692.             $nicecat = $cat;
  693.         }
  694.     $nicecat = substr($nicecat, 0, 9);
  695.  
  696.     printf("%5s  %-8s  %-15s  %9.2f  %9.2f  %-1s %10.2f %14s\n",
  697.            $cutcheck, $nicedate, $cutdesc, $debit, $credit, $cleared, 
  698.            $total, $key);
  699.         printf("%5s  %-8s  %-15s  %-9s %39s\n", "", "", $cutcom, $nicecat, 
  700.            $key);
  701.     }
  702.  
  703.     $| = 1;                # turn buffer flushing back on
  704.  
  705.     return "none";
  706. }
  707.  
  708. # return the first uncleared transaction
  709. sub first_uncleared_trans {
  710.     my($trans);
  711.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk);
  712.     
  713.     if ($CBB::sorted_keys == 0) {
  714.     &sort_keys();
  715.     }
  716.  
  717.     if ($CBB::calced == 0) {
  718.     &calc_trans();
  719.     }
  720.  
  721.     $CBB::current = 0;
  722.     $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]};
  723.     ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk) = 
  724.             split(/\t/, $trans);
  725.     while ( $cleared eq "x" ) {
  726.         ++$CBB::current;
  727.         $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]};
  728.         ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk) = 
  729.                 split(/\t/, $trans);
  730.     }
  731.  
  732.     if ( $trans ) {
  733.         return "$CBB::KEYS[$CBB::current]\t$trans";
  734.     } else {
  735.         return "none";
  736.     }
  737. }
  738.  
  739.  
  740. # return the next uncleared transaction
  741. sub next_uncleared_trans {
  742.     my($trans);
  743.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk);
  744.  
  745.     if ($CBB::sorted_keys == 0) {
  746.     &sort_keys();
  747.     }
  748.  
  749.     if ($CBB::calced == 0) {
  750.     &calc_trans();
  751.     }
  752.  
  753.     ++$CBB::current;
  754.     $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]};
  755.     ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk) = 
  756.             split(/\t/, $trans);
  757.     while ( $cleared eq "x" ) {
  758.         ++$CBB::current;
  759.         $trans = $CBB::TRANS{$CBB::KEYS[$CBB::current]};
  760.         ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $junk) = 
  761.                 split(/\t/, $trans);
  762.     }
  763.  
  764.     if ( $trans ) {
  765.         return "$CBB::KEYS[$CBB::current]\t$trans";
  766.     } else {
  767.         return "none";
  768.     }
  769. }
  770.  
  771.  
  772. # select transaction -- primes a transaction for future clearing
  773. sub select_trans {
  774.     # in: key
  775.     # out: keyed_transaction
  776.  
  777.     my($key) = @_;
  778.     my($trans);
  779.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total);
  780.  
  781.     $CBB::sorted_keys = 0;
  782.     $CBB::calced = 0;
  783.  
  784.     $trans = $CBB::TRANS{$key};
  785.     ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = 
  786.             split(/\t/, $trans);
  787.  
  788.     $cleared = "*";
  789.  
  790.     $CBB::TRANS{$key} = 
  791.       "$date\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t$total";
  792.  
  793.     print DEBUG "selected:  $key to be cleared\n" if $CBB::debug;
  794.  
  795.     return "$key\t$CBB::TRANS{$key}";
  796. }
  797.  
  798.  
  799. # select transaction -- primes a transaction for future clearing
  800. sub unselect_trans {
  801.     # in: key
  802.     # out: keyed_transaction
  803.  
  804.     my($key) = @_;
  805.     my($trans);
  806.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total);
  807.  
  808.     $CBB::sorted_keys = 0;
  809.     $CBB::calced = 0;
  810.  
  811.     $trans = $CBB::TRANS{$key};
  812.     ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = 
  813.             split(/\t/, $trans);
  814.  
  815.     $cleared = "";
  816.  
  817.     $CBB::TRANS{$key} = 
  818.       "$date\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t$total";
  819.  
  820.     print DEBUG "unselected:  $key will not be cleared\n" if $CBB::debug;
  821.  
  822.     return "$key\t$CBB::TRANS{$key}";
  823. }
  824.  
  825.  
  826. # clear all selected transactions
  827. sub clear_trans {
  828.     my($key, $trans);
  829.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total);
  830.  
  831.     if ($CBB::calced == 0) {
  832.     &calc_trans();
  833.     }
  834.  
  835.     if ($CBB::sorted_keys == 0) {
  836.     &sort_keys();
  837.     }
  838.  
  839.     foreach $key (@CBB::KEYS) {
  840.         $trans = $CBB::TRANS{$key};
  841.         ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = 
  842.                 split(/\t/, $trans);
  843.  
  844.     if ( $cleared eq "*" ) {
  845.             $cleared = "x";
  846.  
  847.             $CBB::TRANS{$key} = 
  848.               "$date\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t$total";
  849.         }
  850.     }
  851. }
  852.  
  853.  
  854. # return the cleared balance (this should be the last statement ending bal)
  855. sub get_cleared_bal {
  856.     return sprintf("%.2f", $CBB::BALS{"Xamount"});
  857. }
  858.  
  859.  
  860. # initialize the transactions data structure
  861. sub init_trans {
  862.     # out: result
  863.  
  864.     $CBB::sorted_keys = 0;
  865.     $CBB::calced = 0;
  866.     @CBB::KEYS = ();
  867.  
  868.     return "ok";
  869. }
  870.  
  871.  
  872. # make a new account
  873. sub make_acct {
  874.     # in: acct-name acct-desc acct-type
  875.     # out: result
  876.     
  877.     my($name, $desc) = split(/ /, $_[0], 2);
  878.     my($pos, $short_name);
  879.  
  880.     print DEBUG "Make account $name - $desc\n" if $CBB::debug;
  881.     # print "Make account $name - $desc\n";
  882.  
  883.     print DEBUG "Making cbb account\n" if $CBB::debug;
  884.  
  885.     open(SAVE, ">$name.cbb.new");
  886.     close(SAVE);
  887.     unlink("$name.cbb.bak");
  888.     rename("$name.cbb", "$name.cbb.bak");
  889.     rename("$name.cbb.new", "$name.cbb");
  890.     
  891.     $CBB::current_file = "$name.cbb";
  892.     %CBB::TRANS = ();
  893.  
  894.     # Assume we have category already open ... :| ??? :(
  895.  
  896.     # strip leading path from $name
  897.     &insert_cat("[".&file_basename($name)."]\t$desc\t");
  898.  
  899.     # save the categories file before it gets toasted
  900.     &save_cats(&file_dirname($name) . "/categories");
  901.  
  902.     return "ok";
  903. }
  904.  
  905.  
  906. # determine the file type and call the correct load routine
  907. sub load_trans {
  908.     # in: file base
  909.     # out: result
  910.  
  911.     my($file) = @_;
  912.     my($ext) = &file_extension($file);
  913.  
  914.     # print "$ext\n";
  915.     # print &file_root($file) . "\n";
  916.  
  917.     print DEBUG "file extension is: $ext\n" if $CBB::debug;
  918.  
  919.     if ($CBB::cache) {
  920.         no strict 'vars';    # necessary for this special hack
  921.         no strict 'refs';
  922.  
  923.     # save current data to cache
  924.     my($hname) = "ACC_" . &file_basename($CBB::current_file);
  925.     print DEBUG "$hname $CBB::current_file\n" if $CBB::debug;
  926.     %$hname = %CBB::TRANS;
  927.  
  928.     # test if new table already in cache
  929.     $hname = "ACC_" . &file_basename($file);
  930.     print DEBUG "$hname\n" if $CBB::debug;
  931.     if (scalar (%$hname) ) {
  932.         print DEBUG "$hname defined , load from cache\n" if $CBB::debug;
  933.  
  934.         $CBB::sorted_keys = 0;
  935.         $CBB::calced = 0;
  936.         
  937.         %CBB::TRANS = %$hname;    # take values from the cache
  938.         &calc_trans();
  939.  
  940.         $CBB::current_file = $file;
  941.  
  942.         return "ok";
  943.     }
  944.     }
  945.  
  946.     return &load_cbb_trans($file);
  947. }
  948.  
  949.  
  950. # load the data from a cbb file
  951. sub load_cbb_trans {
  952.     # in: file name (including .cbb extension)
  953.     # out: result
  954.  
  955.     my($file) = @_;
  956.     my($file_version) = "";
  957.     my($junk);
  958.  
  959.     $CBB::sorted_keys = 0;
  960.     $CBB::calced = 0;
  961.  
  962.     print DEBUG "Loading the cbb format file: $file\n" if $CBB::debug;
  963.  
  964.     if ( $CBB::decrypt ne "" ) {
  965.     open(LOAD, "$CBB::decrypt < $file|") || return "error";
  966.     } else {
  967.         open(LOAD, "<$file") || return "error";
  968.     }
  969.  
  970.     %CBB::TRANS = ();    # clear out any transactions from the previous file
  971.  
  972.     while ( <LOAD> ) {
  973.     if ( m/^#/ ) {
  974.         # toss the comment (but first check for any goodies.)
  975.         if ( m/version/i ) {
  976.         ($junk, $junk, $junk, $file_version) = split;
  977.         print DEBUG "Data file version = $file_version\n" if $CBB::debug;
  978.         }
  979.     } else {
  980.         if ( $file_version eq "") {
  981.         print DEBUG "no data file version, file encrypted ?" if $CBB::debug;
  982.         close(LOAD);
  983.         return "error";
  984.         }
  985.             chop;
  986.         if ( ! m/\t/ ) {
  987.         s/:/\t/g;
  988.         $_ = &fix_splits($_);
  989.         }
  990.             &create_trans($_);
  991.     }
  992.     }
  993.  
  994.     close(LOAD);
  995.  
  996.     &calc_trans();
  997.  
  998.     $CBB::current_file = $file;
  999.  
  1000.     return "ok";
  1001. }
  1002.  
  1003.  
  1004. sub fix_splits {
  1005.     # in: transaction with old two field per record splits
  1006.     # out: transaction with new three field per record splits
  1007.  
  1008.     my($line) = @_;
  1009.     my($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) =
  1010.     split(/\t/, $line);
  1011.     my(@cats, $i, $max, $newcat);
  1012.  
  1013.     if ( $cat =~ m/\|/ ) {
  1014.         @cats = split(/\|/, $cat);
  1015.  
  1016.         $i = 0;
  1017.         $max = ($#cats - 1) / 2;
  1018.         $newcat = "|";
  1019.  
  1020.         while ( $i < $max ) {
  1021.             $newcat .= $cats[$i * 2 + 1] . "||" . 
  1022.                $cats[$i * 2 + 2] . "|";
  1023.         $i++;
  1024.         }
  1025.     } else {
  1026.     $newcat = $cat;
  1027.     }
  1028.  
  1029.     return "$date\t$check\t$desc\t$debit\t$credit\t$newcat\t$com\t$cleared\t$total";
  1030. }
  1031.  
  1032.  
  1033. # load the data from a dbm file
  1034. sub load_dbm_trans {
  1035.     # in: file base name
  1036.     # out: result
  1037.  
  1038.     my($file) = @_;
  1039.     print DEBUG "Loading the dbm format file: $file\n" if $CBB::debug;
  1040.  
  1041.     if ( -e "$file" ) {
  1042.     $CBB::current_file = $file;
  1043.     $CBB::sorted_keys = 0;
  1044.     $CBB::calced = 0;
  1045.  
  1046.     dbmclose(%CBB::TRANS);
  1047.     dbmopen(%CBB::TRANS, &file_root($file), 0666) || return "error";
  1048.     
  1049.     # test to see if this file is <tab> delimited
  1050.     &sort_keys();
  1051.     # never ever call calc_trans() at this point (or call something that
  1052.     # calls it
  1053.     if (defined($CBB::TRANS{$CBB::KEYS[0]}) && 
  1054.         !($CBB::TRANS{$CBB::KEYS[0]} =~ m/\t/) ) {
  1055.         print DEBUG "'$CBB::TRANS{$CBB::KEYS[0]}' = old version of CBB dbm file\n"
  1056.         if $CBB::debug;
  1057.         return "error - old version of CBB dbm file";
  1058.     } else {
  1059.         print DEBUG "valid txn: '$CBB::TRANS{$CBB::KEYS[0]}'\n" 
  1060.         if $CBB::debug;
  1061.         }
  1062.  
  1063.     return "ok";
  1064.     } else {
  1065.     return "error";
  1066.     }
  1067. }
  1068.  
  1069.  
  1070. # save all the precious data to a file
  1071. sub save_trans {
  1072.     # in: file name (including .cbb extension)
  1073.     # out: result
  1074.  
  1075.     my($file) = @_;
  1076.     my($auto_save_file, $key);
  1077.     my(@trans);
  1078.  
  1079.     print DEBUG "Saving the cbb format file: $file\n" if $CBB::debug;
  1080.  
  1081.     if ($CBB::calced == 0) {
  1082.     &calc_trans();
  1083.     }
  1084.  
  1085.     if ($CBB::sorted_keys == 0) {
  1086.     &sort_keys();
  1087.     }
  1088.  
  1089.     if ( $CBB::encrypt ne "" ) {
  1090.     open(SAVE, "|$CBB::encrypt > $file.new") || return "error";
  1091.     } else {
  1092.         open(SAVE, ">$file.new") || return "error";
  1093.     }
  1094.  
  1095.     # Print some header stuff
  1096.     print (SAVE "# CBB Data File -- $file\n");
  1097.     print (SAVE "#\n");
  1098.     print (SAVE "# CBB Version = $CBB::version_num\n");
  1099.     printf (SAVE "# Current Balance = %.2f\n", $CBB::BALS{Current});
  1100.     printf (SAVE "# Ending Balance = %.2f\n", $CBB::BALS{Amount});
  1101.     print (SAVE "# Transaction Count = $CBB::BALS{Count}\n");
  1102.     printf (SAVE "# Cleared Balance = %.2f\n", $CBB::BALS{Xamount});
  1103.     print (SAVE "# Cleared Txn Count = $CBB::BALS{Xcount}\n");
  1104.     print (SAVE "# Saved on (US Date Fmt) " . &nice_date("1") . " ");
  1105.     print (SAVE "by $CBB::user_name\n");
  1106.     print (SAVE "#\n");
  1107.     print (SAVE "# date  check  desc  debit  credit  cat  com  cleared\n");
  1108.     print (SAVE "# ---------------------------------------------------\n");
  1109.  
  1110.     foreach $key (@CBB::KEYS) {
  1111.     # strip off last total
  1112.     @trans = split(/\t/, $CBB::TRANS{$key});
  1113.     print SAVE join ("\t", @trans[0..7]) . "\n";
  1114.     }
  1115.  
  1116.     close(SAVE);
  1117.  
  1118.     unlink("$file.bak");
  1119.     rename("$file", "$file.bak");
  1120.     rename("$file.new", "$file");
  1121.  
  1122.     $auto_save_file = &file_dirname($file) . "#" . &file_basename($file) . "#";
  1123.     print DEBUG "auto_save_file = $auto_save_file\n" if $CBB::debug;
  1124.     if ( -e $auto_save_file ) {
  1125.     unlink("$auto_save_file");
  1126.     unlink("$auto_save_file.bak");
  1127.     }
  1128.  
  1129.     return "ok";
  1130. }
  1131.  
  1132.  
  1133. 1;
  1134.  
  1135. # ----------------------------------------------------------------------------
  1136. # $Log: engine.pl,v $
  1137. # Revision 2.20  1998/08/14 14:30:11  curt
  1138. # Patches to the graphs/graphbal script to avoid divide by zero in certain
  1139. # circumstances.
  1140. #
  1141. # Revision 2.19  1998/08/14 14:28:35  curt
  1142. # Added desc-pie graph.
  1143. # Added option to eliminate splash screen.
  1144. # Other misc. tweaks and bug fixes.
  1145. #
  1146. # Revision 2.18  1997/05/06 02:35:14  curt
  1147. # Removed an extranious my()
  1148. #
  1149. # Revision 2.17  1997/05/06 01:00:27  curt
  1150. # Added patches contributed by Martin Schenk <schenkm@ping.at>
  1151. # - Default to umask of 066 so .CBB files get created rw by owner only
  1152. # - Added support for pgp encrypting data files
  1153. # - Added support for displaying only recent parts of files (avoids
  1154. #   waiting to load in lots of old txns you don't currently need.)
  1155. # - Added a feature to "cache" whole accounts in the perl engine so
  1156. #   that switching between accounts can be faster.
  1157. # - The above options can be turned on/off via the preferrences menu.
  1158. #
  1159. # Revision 2.16  1997/04/12 01:15:24  curt
  1160. # Display current balance rather than ending balance in the account list
  1161. # box.  This makes a difference if you like to insert future transactions.
  1162. #
  1163. # Revision 2.15  1997/04/11 20:24:01  curt
  1164. # Automatically insert new transactions into the memorized list.
  1165. #
  1166. # Revision 2.14  1997/04/04 18:41:35  curt
  1167. # Fixed a small bug in editing transfer transactions.
  1168. #
  1169. # Revision 2.13  1997/03/04 03:23:00  curt
  1170. # Fixed bug which caused a transfer transaction to not show up in the list
  1171. # box even though it had been correctly inserted.
  1172. #
  1173. # Revision 2.12  1997/01/18 03:28:42  curt
  1174. # Added "use strict" pragma to enforce good scoping habits.
  1175. #
  1176. # Revision 2.11  1997/01/10 22:03:30  curt
  1177. # Transfer fixups and a few other misc. fixes contributed by
  1178. #   Lionel Mallet <Lionel.Mallet@sophia.inria.fr>
  1179. #
  1180. # Revision 2.10  1997/01/02 04:38:32  curt
  1181. # Changes over the 1996 holidays:
  1182. #   - Converted listbox to text widget.  This allows us to do nice
  1183. #     things with alternating background colors, highliting, red
  1184. #     negative numbers, etc.
  1185. #   - Negative transactions are now drawn in red.
  1186. #   - Added a Goto <Today> option.
  1187. #   - <Home> & <End> were double bound.  Now, listbox can be traversed with
  1188. #     <Meta-Home> and <Meta-End>
  1189. #
  1190. # Revision 2.9  1996/12/17 20:15:43  curt
  1191. # Version incremented to 0.70.
  1192. # No longer save running total in .cbb files.
  1193. # Miscellaneous tweaks.
  1194. #
  1195. # Revision 2.8  1996/12/17 14:53:54  curt
  1196. # Updated copyright date.
  1197. #
  1198. # Revision 2.7  1996/12/11 18:33:32  curt
  1199. # Ran a spell checker.
  1200. #
  1201. # Revision 2.6  1996/10/02 19:37:19  curt
  1202. # Replaced instances of hardcoded century (19) with a variable.  We need to
  1203. # know the current century in cases where it is not provided and it is
  1204. # assumed to be the current century.  Someday I need to figure out how
  1205. # to determine the current century, but I have a couple of years to do it. :-)
  1206. #
  1207. # I still need to fix conf-reports and reports.pl
  1208. #
  1209. # Revision 2.5  1996/09/26 19:48:44  curt
  1210. # Fixed some problems with the newly revamped tab completion code.
  1211. #
  1212. # Revision 2.4  1996/07/30 14:35:33  curt
  1213. # Fixed a typo introduced in previous (field width change).
  1214. #
  1215. # Revision 2.3  1996/07/24 20:17:14  curt
  1216. # Added Arlindo M. L. Oliveira's "total" field with fix for handling higher
  1217. # numbers.
  1218. #
  1219. # Revision 2.2  1996/07/13 02:57:41  curt
  1220. # Version 0.65
  1221. # Packing Changes
  1222. # Documentation changes
  1223. # Changes to handle a value in both debit and credit fields.
  1224. #
  1225. # Revision 2.1  1996/02/27  05:35:40  curt
  1226. # Just stumbling around a bit with cvs ... :-(
  1227. #
  1228. # Revision 2.0  1996/02/27  04:41:53  curt
  1229. # Initial 2.0 revision.  (See "Log" files for old history.)
  1230.