home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / contrib / txn < prev    next >
Text File  |  1998-10-07  |  7KB  |  251 lines

  1. #!/usr/bin/perl
  2. #
  3. # Christopher B. Browne, cbbrowne@hex.net, chris_browne@sdt.com
  4. # Web: http://www.conline.com/~cbbrowne  SAP Basis Consultant, UNIX Guy
  5. # Windows NT - How to make a 100 MIPS Linux workstation perform like an 8 MHz 
  6. # 286
  7. #
  8. # $Id: txn,v 2.2 1997/07/02 18:36:57 curt Exp $
  9.  
  10. $name = shift(@ARGV); $name =~ tr/A-Z/a-z/;
  11. $homedir = "/home/cbbrowne/kwiken/";
  12.  
  13. # find the *real* file name (with lots of chances to die if it's not a
  14. # particularly valid name)
  15. $datafile = &find_cbb_file($name, $homedir); 
  16.  
  17. # See if the file is really and truly a CBB data file
  18. &die_if_not_cbb($datafile);
  19.  
  20. # initial error checking:
  21. if ($#ARGV != 5) {
  22.    &report_bad_args($#ARGV);
  23.    die(-1);
  24. }
  25.  
  26. ($indate, $check, $payee, $cat, $amount, $desc) = @ARGV;
  27.  
  28. $txndate = &fiddle_with_date($indate);
  29.  
  30. if ($amount < 0) {
  31.     $credit = sprintf("%.2f", -$amount);
  32.     $debit=0.0;
  33. } else {
  34.     $debit = sprintf("%.2f", $amount);
  35.     $credit=0.0;
  36. }
  37.  
  38. #$newbal = sprintf("%.2f", $lastbal + $credit - $debit);
  39.  
  40. # Check the category/categories
  41. $cat = &split_txn($cat, $amount);
  42. if ($cat eq "-1" || $cat eq "") {
  43.     print "Did not exist!\n";
  44.     die -1;
  45. }
  46.  
  47. $rec = "";
  48.  
  49. $txn = "$txndate\t$check\t$payee\t$debit\t$credit\t$cat\t$desc\t$rec";
  50.  
  51. open(OUT, ">>$datafile");
  52. print OUT $txn, "\n";
  53. close(OUT);
  54.  
  55. print "Added to $datafile\n";
  56. print "$txn\n";
  57. #print "New balance: $newbal\n";
  58.  
  59. exit 0;
  60.  
  61. ############################################################
  62. ############################################################
  63. ############################################################
  64.  
  65. sub split_txn {
  66.     local ($scat, $amount, $total) = @_;
  67.     if (index($scat, "|", 0) != -1) {
  68.     # Split transaction; look for the pieces, see if they add up
  69.     @PIECES=split(/\|/, $scat);
  70.     if (($#PIECES % 2) == 1) {
  71.         print "Split does not have appropriate number of pieces\n";
  72.         die -1;
  73.     }
  74.     @SPLIT = ();  # Initialize the result array
  75.     shift(@PIECES);  # First item gets trashed
  76.     while (@PIECES) {
  77.         $scat = &find_cats(shift(@PIECES));
  78.         $samount = &remove_commas(shift(@PIECES));
  79.         push(@SPLIT, $scat);
  80.         push(@SPLIT, $samount);
  81.         $total -= $samount;
  82.         if (substr($scat, 0, 1) eq "[") {
  83.         # This is a transfer inside a split
  84.         $tftxn = "txn '$scat' '$txndate' '$check' 'Funds Transfer (split)' '[$name]' 
  85. $samount '$desc'";
  86.         push(@TFTXNS, $tftxn);
  87.         }
  88.     }
  89.     if ((($total - $amount) > 0.005) || (($total - $amount) < -0.005)) {
  90.         printf "Split amounts add up to %.2f; not the same as the total %.2f\n",
  91.         $total, $amount;
  92.         die -1;
  93.     } else {
  94.         # Re-assemble the string using what was determined here
  95.         $scat = "|".join("|", @SPLIT);
  96.         while (@TFTXNS) {
  97.         system (pop(@TFTXNS));
  98.         }
  99.     }
  100.     } else {
  101.     $scat = &find_cats($scat);
  102.     }
  103.     return $scat;
  104. }
  105.  
  106.  
  107. sub find_cats {
  108.     local ($category) = @_;
  109.     $category =~ tr/A-Z/a-z/;
  110.     local (@MATCH, $lowkey, $key, $value);
  111.     
  112.     # Search the category list for matches.  If only one is found, then
  113.     # return it as $cat.  If more than one is found, put them in @MATCH.
  114.     # $lowkey is used for the search, so that it's all case insensitive
  115.     
  116.     $categoryfile = $homedir."categories";
  117.     $match = `grep -i "$category" $categoryfile`;
  118.     @MATCH=();
  119.     @FOUND = split(/\n/, $match);
  120.     foreach $line (0..$#FOUND) {
  121.     ($key, $value) = split(/\t/, $FOUND[$line]);
  122.     print "[$key] [$value]\n";
  123.         $lowkey = $key;
  124.     $lowkey =~ tr/A-Z/a-z/;
  125.         push(@MATCH,$key);
  126.     } 
  127.     
  128.     # Now, see if the category is valid...
  129.     if ($#MATCH == -1) {
  130.     print "No matches found for $category!\n";
  131.     return -1;
  132.     } elsif ($#MATCH == 0) {
  133. #    print "Ok - found $category\n";
  134.     return $MATCH[0];
  135.     } else {
  136.     print "Transaction dated [$txndate]  Ref # [$check] to [$payee]\n";
  137.         printf "Amount: DR %12.2f CR %12.2f Re: %s\n", $debit, $credit, $desc;
  138.     print "\nCategory code [$category] is ambiguous:\n";
  139.     printf " #  Category Name      Long Description\n";
  140.         printf "----------------------------------------------------------\n";
  141.     foreach $i (0..$#MATCH) {
  142.         printf "%2d %-20s %s\n", $i, $MATCH[$i], $CATS{$MATCH[$i]};
  143.     }
  144.     print "Pick one: (invalid entry to abort): ";
  145.     $alt=<STDIN>;
  146.     if (($alt > $#MATCH) || ($alt < 0)
  147.         || ($alt lt 0) || ($alt gt "99")) {
  148.         print "Invalid value - ABORT!";
  149.         exit(-1);
  150.     }
  151.     else 
  152.     {
  153.         return $MATCH[$alt];
  154.     }
  155.     }
  156. }
  157.  
  158. sub die_if_not_cbb {
  159.     local ($datafile) = @_;
  160.     $head = `head -1 $datafile`;  # Grab the first line of the file
  161.     if ($head =~ /CBB Data File --/) {
  162.     # OK
  163.     # Pre v0.70 - read the last line, and grab the last balance.
  164.     # Post v0.70 - there is no "balance" field in the .cbb file to read.
  165.     # $lasttxn = `tail -1 $datafile`;  # Grab the last line of the file
  166.     # ($x1, $x2, $x3, $x4, $x5, $x6, $x7, $x8, $lastbal) = split(/\t/, $lasttxn);
  167.     # $lastbal = sprintf("%.2f", $lastbal);
  168.        return;
  169.    } else {
  170.        print $head;
  171.        print "Data file $datafile doesn't look like it's a CBB file\n";
  172.        die -1;
  173.    }
  174. }
  175.  
  176. sub find_cbb_file {
  177.     local ($id, $homedir) = @_;
  178.     local ($datafile) = $homedir.$id;   
  179.     if (!($datafile =~ /\.cbb/) ){
  180.     $datafile .= ".cbb";
  181.     }
  182.     if (-e $datafile) {
  183.      # Ok
  184.     } else {
  185.     print "Could not find file $datafile\n";
  186.     die -1;
  187.     }
  188.     if (!( -w $datafile)) {
  189.     print "You're not allowed to write to $datafile!\n";
  190.     die -1;
  191.     }
  192.    return $datafile;   
  193. }
  194.  
  195. sub report_bad_args {
  196.     local ($nargs) = @_;
  197.     print "incorrect argument count - [$nargs]\n";
  198.     print "txn  [Source_acct]  [Date]  [Ref#]  [Payee]  [Category]  [Amount]  
  199. [Comment]\n\n";
  200.     print "    Adds a financial transaction to a cbb file\n";
  201.     print "    use '-t' to fill in today's date\n\n";
  202.     print "Example:\n  dantzig[90]> txn cash -t 'n/a' '1st Cdn Place' 'Lunch' 
  203. 4.27 ''\n";
  204. }
  205.  
  206. sub fiddle_with_date {
  207.     local ($indate) = @_;
  208.     local($g,$g,$g,$day,$month,$year,$g,$g,$g)=localtime(time);
  209.     local($todaydate) = sprintf ("%02d%02d%02d", $year, $month+1,
  210.                  $day+1);
  211.     local ($txndate) = $indate;
  212.     if ($txndate eq "-t") {
  213.     $txndate = $todaydate;
  214.     }
  215.     
  216.     # If the date is 2 digits, then the transaction is merely specifying
  217.     # the day within this month.
  218.     if (length($txndate) <= 2) {
  219.     $txndate = substr($todaydate, 0, 4).sprintf("%02d", $txndate);
  220.     }
  221.     
  222. # If the date is 4 digits long, then it's specifying date and month.
  223. # Insert the year (just YY at this point).
  224.     if (length($txndate) == 4) {
  225.     $txndate = substr($todaydate, 0, 2).sprintf("%04d", $txndate);
  226.     }
  227.  
  228.     
  229.     $century = "19";        # In the year 2000, this will need to change.
  230.     if (length($txndate) != 8) {
  231.     $txndate = $century.$txndate;
  232.     }
  233.     
  234.     local($year, $month, $day) = (substr($txndate, 0, 4), 
  235.                   substr($txndate, 4, 2),
  236.                   substr($txndate, 6, 2));
  237.     
  238. # This really ought to consider the number of days in each month;
  239. # e.g., February 30th never exists.  I haven't bothered.
  240.     
  241. # Now, validate a whack of stuff all at once, and die if everything
  242. # doesn't seem correct.
  243.     if ((length($txndate) != 8) || ($month < 1) || ($month > 12)
  244.     || ($day < 1) || ($day > 31)) {
  245.     print "Date [$txndate] formatted incorrectly - use YYYYMMDD\n";
  246.     die -1;
  247.     }
  248.     
  249.     return $txndate;
  250. }
  251.