home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / graphs / cat-pie.pl < prev    next >
Perl Script  |  1998-10-07  |  6KB  |  212 lines
  1. #!/usr/bin/perl
  2. #  cat-pie.pl - Graphs a pie chart of categories
  3. #
  4. #  Modified by Arlindo L. Oliveira (aml@inesc.pt)
  5. #
  6. #  Copyright (C) 1994  Curtis L. Olson  - curt@sledge.mn.org
  7. #
  8. #  This program is free software; you can redistribute it and/or modify
  9. #  it under the terms of the GNU General Public License as published by
  10. #  the Free Software Foundation; either version 2 of the License, or
  11. #  (at your option) any later version.
  12. #
  13. #  This program is distributed in the hope that it will be useful,
  14. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. #  GNU General Public License for more details.
  17. #
  18. #  You should have received a copy of the GNU General Public License
  19. #  along with this program; if not, write to the Free Software
  20. #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. # $Id: cat-pie.pl,v 2.5 1997/05/06 02:33:50 curt Exp $
  23. # (Log is kept at end of this file)
  24.  
  25.  
  26. package CBB;
  27.  
  28. use strict;    # don't take no guff
  29.  
  30.  
  31. my($tmp, $temp, $cbb_incl_dir);
  32. my($key, $date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total);
  33. my($credit_total, $debit_total, $amt, $lkey, $lcat, $subtotal);
  34. my($tcom, $tamt, $tcat);
  35. my(@keys, %ALLTRANS, @splits);
  36. my($graphpath, $account, $name, $result);
  37.  
  38.  
  39. # return the directory of a file name (this is duplicated in common.pl
  40. # but we need this to find the include directory for common.pl :-(
  41. sub my_file_dirname {
  42.     my($file) = @_;
  43.     my($pos);
  44.  
  45.     $pos = rindex($file, "/");
  46.     if ( $pos >= 0 ) {
  47.     return substr($file, 0, ($pos + 1));
  48.     } else { 
  49.     return "./"; 
  50.     }
  51. }
  52.  
  53. # specify the installed location of the necessary pieces.
  54. $temp = &my_file_dirname($0); chop($temp);
  55. $cbb_incl_dir = &my_file_dirname($temp);
  56. unshift(@INC, $cbb_incl_dir);
  57.  
  58. $graphpath = "/usr/X11R6/lib/X11/cbb/graphs";
  59.  
  60. require "common.pl";
  61. require "reports.pl";
  62. require "engine.pl";
  63. require "memorized.pl";
  64.  
  65.  
  66. ($#ARGV >= 0) || die "Usage: report [ -from date ] [ -to date] accounts";
  67.  
  68.  
  69. # process arguments
  70.  
  71. my($fromdate, $todate, @account_list) = &process_rep_args();
  72.  
  73. if ( $fromdate eq "all" ) {
  74.     $fromdate = "";
  75. }
  76.  
  77. if ( $todate eq "all" ) {
  78.     $todate = "";
  79. }
  80.  
  81. # print "'$fromdate' '$todate' '@account_list'\n";
  82.  
  83. %ALLTRANS = ();
  84.  
  85. # load all matching transactions from all specified accounts (ignoring
  86. # those that are outside the specified date range)
  87.  
  88. my(%tmp_cat) = ();
  89.  
  90. foreach $account ( @account_list ) {
  91.     $name = &file_basename($account);
  92.  
  93.     # open the account
  94.     (&load_trans($account) eq "ok") || die "Cannot open account:  $account";
  95.  
  96.     $result = &first_trans();
  97.     while ( $result ne "none" ) {
  98.         ($key, $date, $check, $desc, $debit, $credit, $cat, $com, $cleared,
  99.          $total) = split(/\t/, $result);
  100.  
  101.         $amt = $credit - $debit;
  102.  
  103.         if ( (($fromdate == 0) || ($fromdate <= $date)) && 
  104.             (($todate == 0) || ($todate >= $date)) ) {
  105.  
  106.             $ALLTRANS{"$key$name"} = $result;
  107.  
  108.             if ( substr($cat, 0, 1) ne "|" ) {
  109.                 $tmp_cat{$cat} .= "$key$name" . "," . $amt . ",";
  110.             } else {
  111.                 # process split
  112.  
  113.                 @splits = split(/\|/, $cat);
  114.                 shift(@splits);
  115.  
  116.                 $tmp = 0;
  117.                 while ( $#splits >= 0 ) {
  118.                     $tcat = shift(@splits);
  119.                     $tcom = shift(@splits);
  120.                     $tamt = shift(@splits);
  121.  
  122.                     $tmp += $tamt;
  123.  
  124.                     # print "processing $tcat $tamt\n";
  125.                     $tmp_cat{$tcat} .= "$key$name" . "," . $tamt . ",";
  126.                 }
  127.                 if ( sprintf("%.2f", $tmp) ne sprintf("%.2f", $amt) ) {
  128.                     printf("WARNING:  Incorrect splits in $date: $desc\n");
  129.                     printf("    %.2f != %.2f\n\n", $tmp, $amt);
  130.                 }
  131.             }
  132.         }
  133.  
  134.         $result = &next_trans();
  135.     }
  136. }
  137.  
  138.  
  139. $credit_total = 0.00;
  140. $debit_total = 0.00;
  141.  
  142. if ( ! -x "$graphpath/graphpie") {
  143.     die "Cannot launch $graphpath/graphpie\n";
  144. }
  145.  
  146. open(DATA,"| $graphpath/graphpie") || die "Cannot launch graph\n";
  147.  
  148. foreach $lcat (sort keys(%tmp_cat)) {
  149.     
  150.     chop($tmp_cat{$lcat});  # Delete final comma
  151.  
  152.     @keys = split(/,/, $tmp_cat{$lcat});
  153.  
  154.     $subtotal = 0.00;
  155.  
  156.     while ( $#keys >= 0 ) {
  157.         $lkey = shift(@keys);
  158.         $amt  = shift(@keys);
  159.  
  160.         $result = $ALLTRANS{$lkey};
  161.  
  162.         ($key, $date, $check, $desc, $debit, $credit, $cat, $com, $cleared,
  163.          $total) = split(/\t/, $result);
  164.  
  165.         $subtotal = $subtotal + $amt;
  166.         if ( $amt > 0 ) {
  167.             $credit_total = $credit_total + $amt;
  168.         } else {
  169.             $debit_total = $debit_total + $amt;
  170.         }
  171.     }
  172.  
  173.     $lcat =~ s/ /-/g;
  174.     $lcat eq "" and $lcat="<empty>";
  175.     print DATA "$lcat $subtotal\n";
  176.     # printf(" = %9.2f\n", $subtotal);
  177. }
  178.  
  179.  
  180. # printf("                                      ---------\n" );
  181. # printf("                      Total Credits = %9.2f\n\n", $credit_total);
  182.  
  183. # printf("                                         ---------\n" );
  184. # printf("                       Total Debits = %9.2f\n\n", $debit_total);
  185.  
  186. # printf("                                         ---------\n" );
  187. # printf("                            Balance = %9.2f\n\n", 
  188. #       $credit_total + $debit_total);
  189.  
  190. close(DATA);
  191.  
  192.  
  193. # ----------------------------------------------------------------------------
  194. # $Log: cat-pie.pl,v $
  195. # Revision 2.5  1997/05/06 02:33:50  curt
  196. # Added "require memorized".
  197. #
  198. # Revision 2.4  1997/01/28 03:25:40  curt
  199. # Force strict scoping in all perl scripts.
  200. #
  201. # Revision 2.3  1996/12/13 01:25:18  curt
  202. # Updated paths, modified to work with reports.tcl
  203. #
  204. # Revision 2.2  1996/07/13 02:58:32  curt
  205. # Misc. changes.
  206. #
  207. # Revision 2.1  1996/02/27  05:36:11  curt
  208. # Just stumbling around a bit with cvs ... :-(
  209. #
  210. # Revision 2.0  1996/02/27  04:43:20  curt
  211. # Initial 2.0 revision.  (See "Log" files for old history.)
  212.