home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / contrib / recur.pl < prev    next >
Encoding:
Perl Script  |  1998-10-07  |  9.7 KB  |  355 lines
  1. #!/usr/bin/perl
  2. #  recur.pl - Manage and update recurring transactions in a .cbb file.
  3. #
  4. #  Written by Curtis Olson.  Started January 16, 1996.
  5. #
  6. #  Copyright (C) 1996  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: recur.pl,v 2.9 1998/08/14 14:28:44 curt Exp $
  23. # (Log is kept at end of this file)
  24.  
  25.  
  26. use strict;    # don't take no guff
  27.  
  28. require "timelocal.pl";
  29.  
  30.  
  31. package CBB;
  32.  
  33. my($key, $date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total);
  34. my($recur, $result, $update);
  35. my($future_days, $secs_per_day, $cur_date, $account);
  36.  
  37.  
  38. # specify the installed location of the necessary pieces.
  39. $CBB::cbb_incl_dir = "/usr/X11R6/lib/X11/cbb";
  40. unshift(@INC, $CBB::cbb_incl_dir);
  41.  
  42. require "memorized.pl";
  43. require "categories.pl";
  44. require "common.pl";
  45. require "engine.pl";
  46. require "memorized.pl";
  47.  
  48.  
  49. ($#ARGV >= 0) || die "Usage: $0 account";
  50.  
  51.  
  52. # how many days to plan ahead
  53. #$future_days = 366;        # approximately 1 year;
  54. $future_days = 92;        # approximately 3 months;
  55. $secs_per_day = 86400;        # seconds per day;
  56.  
  57. $cur_date = &raw_date;
  58.  
  59. $account = shift(@ARGV);
  60. if ( $account !~ /\.cbb$/ ) {
  61.     die "Account name must end in '.cbb'\n";
  62. }
  63.  
  64. (&load_trans($account) eq "ok") || die "Cannot open account:  $account";
  65.  
  66. #-----------------------------------------------------------------------
  67. # Traverse all transactions and perform the following steps on entries with
  68. # $cleared = "?":
  69. # 
  70. #   1.  If date has passed, change $cleared to "!"
  71. #   2.  If date is present or future, delete entry.  These entries will be
  72. #       reinserted later.
  73. #-----------------------------------------------------------------------
  74.  
  75. print "Updating/deleting current recurring transactions:  ";
  76.  
  77. $result = &first_trans();
  78. while ( $result ne "none" ) {
  79.     ($key, $date, $check, $desc, $debit, $credit, $cat, $com, $cleared,
  80.      $total) = split(/\t/, $result);
  81.  
  82.     if ( $cleared eq "?" ) {
  83.     if ( $date < $cur_date ) {
  84.         # set $cleared to "!"
  85.         # print "updating - $result\n";
  86.         print ".";
  87.         $update = "$key\t$date\t$check\t$desc\t$debit\t$credit\t".
  88.         "$cat\t$com\t!\t$total";
  89.         &update_trans($update);
  90.     } else {
  91.         # delete
  92.         # print "deleting - $result\n";
  93.         print ".";
  94.         &delete_trans($key);
  95.     }
  96.     }
  97.     
  98.     $result = &next_trans();
  99. }
  100.  
  101. print "\n";
  102.  
  103.  
  104. #-----------------------------------------------------------------------
  105. # Now add in all future recurring transactions
  106. #-----------------------------------------------------------------------
  107.  
  108. print "Adding in future recurring transactions:  ";
  109.  
  110. # print "$account - " . &file_root($account) . "\n";
  111. $recur = &file_root($account) . ".rcr";    # 
  112. # print "$recur\n";        # 
  113. open(RECUR, "<$recur") || die "Cannot open:  $recur";
  114.  
  115. while ( <RECUR> ) {
  116.     # print length($_) . " - $_";
  117.     if ( m/^#/ || ! m/\t/ ) {
  118.     # ignore this line
  119.     } else {
  120.     # Ok, we found one!
  121.     &add_all_recurs($_);
  122.     }
  123. }
  124.  
  125. close(RECUR);
  126.  
  127. # Finally, save the result
  128.  
  129. (&save_trans("$account") eq "ok") || die "Cannot save account:  $account";
  130.  
  131.  
  132. #-----------------------------------------------------------------------
  133. # Supporting Routines
  134. #-----------------------------------------------------------------------
  135.  
  136. # Add all recuring transactions specified
  137.  
  138. sub add_all_recurs {
  139.     my($line) = @_;
  140.     my($days, $months, $years, $desc, $debit, $credit, $com, $cat, $begindate, 
  141.        $cutoff);
  142.     my($date, $dates, $key, $trans, @DATES);
  143.  
  144.     chop($line);
  145.  
  146.     ($days, $months, $years, $desc, $debit, $credit, $com, $cat,
  147.      $begindate, $cutoff) = split(/\t/, $line);
  148.  
  149.     if ( ($begindate eq "") || ($begindate < $cur_date) ) {
  150.     $begindate = $cur_date;
  151.     }
  152.  
  153.     if ( $cutoff eq "" ) {
  154.     $cutoff = &calc_cutoff();
  155.     }
  156.  
  157.     # print "cutoff = $cutoff\n";
  158.  
  159.     if ( ($days < 32) || ($days =~ m/,/) || ($days eq "*") ) {
  160.     # type 1 recurring transaction
  161.     $dates = &gen_dates_1($days, $months, $years, $begindate, $cutoff);
  162.     # print "$dates\n";
  163.     } else {
  164.     # type 2 recurring transaction
  165.     $dates = &gen_dates_2($days, $months, $years, $begindate, $cutoff);
  166.     # print "$dates\n";
  167.     }
  168.  
  169.     @DATES = split(/,/, $dates);
  170.  
  171.     foreach $date (@DATES) {
  172.     print ".";
  173.     $trans = "$date\t\t$desc\t$debit\t$credit\t$cat\t$com\t?\t";
  174.         if ($cat =~ m/^\[/) {
  175.             $key = &create_xfer($trans);
  176.         } else {
  177.             $key = &create_trans($trans);
  178.         }
  179.     }
  180. }
  181.  
  182. print "\n";
  183.  
  184.  
  185. # Calculate cutoff date
  186.  
  187. sub calc_cutoff {
  188.     my($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = 
  189.         localtime(time);
  190.     my($cutoff_secs, $today_secs);
  191.  
  192.     # print "calling timelocal with cmon = $cmon\n";
  193.     $today_secs = &main'timelocal(0, 0, 0, $cmday, $cmon, $cyear);
  194.     $cutoff_secs = $today_secs + ($future_days * $secs_per_day);
  195.  
  196.     ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = 
  197.         localtime($cutoff_secs);
  198.  
  199.     return ¢ury() . $cyear . &pad($cmon + 1) . &pad($cmday);  
  200. }
  201.  
  202.  
  203. # Generate a list of type 1 dates
  204.  
  205. sub gen_dates_1 {
  206.     my($days, $months, $years, $begindate, $cutoff) = @_;
  207.     my($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = 
  208.         localtime(time);
  209.     my($ldates) = "";
  210.     my($day, $month, $year, $tdays, $tmonth, $tyear);
  211.     my($this_date, $month_end, $next_month);
  212.     my(@DAYS, @MONTHS, @YEARS);
  213.  
  214.     # print "$days - $months - $years\n";
  215.  
  216.     if ( $months eq "*" ) {
  217.     $months = "1,2,3,4,5,6,7,8,9,10,11,12";
  218.     }
  219.     @MONTHS = split(/,/, $months);
  220.  
  221.     if ( $years eq "*" ) {
  222.     $years = "$cyear," . ($cyear+1);
  223.     }
  224.     @YEARS = split(/,/, $years);
  225.  
  226.     foreach $year (@YEARS) {
  227.     foreach $month (@MONTHS) {
  228.         # print ¢ury() . $year . &pad($month) . "\n";
  229.         if ( $month == 12 ) {
  230.         $tyear = $year + 1; $tmonth = 1;
  231.         } else {
  232.         $tyear = $year; $tmonth = $month + 1;
  233.         }
  234.         # note in perl the months start at 0 ... :(
  235.         # print "calling timelocal with tmonth = $tmonth \n";
  236.         $next_month = &main'timelocal(0, 0, 0, 1, ($tmonth - 1), $tyear);
  237.         # subtract the number of seconds in a day to get the last
  238.         # day of the previous month
  239.         $month_end = $next_month - $secs_per_day;
  240.         ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = 
  241.         localtime($month_end);
  242.  
  243.         if ( $days eq "*" ) {
  244.         $tdays = "1";
  245.         $day = 2;
  246.         while ( $day <= $cmday ) {
  247.             $tdays .= "," . $day;
  248.             $day++;
  249.         }
  250.         } else {
  251.         $tdays = $days;
  252.         $tdays =~ s/last/$cmday/;
  253.         }
  254.  
  255.         # print "$tdays\n";
  256.  
  257.         @DAYS = split(/,/, $tdays);
  258.         foreach $day (@DAYS) {
  259.         $this_date = ¢ury() . $year . &pad($month) . &pad($day);
  260.         if ( ($this_date >= $begindate) && ($this_date <= $cutoff) ) {
  261.             # print "$this_date\n";
  262.             if ( $ldates eq "" ) {
  263.             $ldates = $this_date;
  264.             } else {
  265.             $ldates .= "," . $this_date;
  266.             }
  267.         }
  268.         }
  269.     }
  270.     }
  271.  
  272.     return $ldates;
  273. }
  274.  
  275.  
  276. # Generate a list of type 2 dates
  277.  
  278. sub gen_dates_2 {
  279.     my($start, $incr, $junk, $begindate, $cutoff) = @_;
  280.     my($ldates) = "";
  281.     my($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst);
  282.     my($scentury, $syear, $smonth, $sday) = 
  283.     $start =~ /(\d\d)(\d\d)(\d\d)(\d\d)/;
  284.     my($secs, $sincr, $start_secs, $this_date);
  285.  
  286.     # print "$syear - $smonth - $sday\n";
  287.  
  288.     # print "calling timelocal with smonth = $smonth\n";
  289.     $start_secs = &main'timelocal(0, 0, 0, $sday, ($smonth - 1), $syear);
  290.     $sincr = $incr * $secs_per_day;
  291.  
  292.     $secs = $start_secs;
  293.     ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = 
  294.     localtime($secs);
  295.     $this_date = ¢ury() . $cyear . &pad($cmon + 1) . &pad($cmday);
  296.     while ( $this_date <= $cutoff ) {
  297.     if ( $this_date >= $begindate ) {
  298.         if ( $ldates eq "" ) {
  299.         $ldates = $this_date;
  300.         } else {
  301.         $ldates .= "," . $this_date;
  302.         }
  303.         # print "$this_date\n";
  304.     }
  305.     $secs += $sincr;
  306.     ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = 
  307.         localtime($secs);
  308.     $this_date = ¢ury() . $cyear . &pad($cmon + 1) . &pad($cmday);
  309.     }
  310.  
  311.     return $ldates;
  312. }
  313.  
  314.  
  315. #----------------------------------------------------------------------------
  316. # $Log: recur.pl,v $
  317. # Revision 2.9  1998/08/14 14:28:44  curt
  318. # Added desc-pie graph.
  319. # Added option to eliminate splash screen.
  320. # Other misc. tweaks and bug fixes.
  321. #
  322. # Revision 2.8  1997/02/28 21:21:58  curt
  323. # Fixed some problems introduced by using "use strict"
  324. #
  325. # Revision 2.7  1997/02/19 18:09:09  curt
  326. # Fixed some residual oversites from switching to "use strict".
  327. #
  328. # Revision 2.6  1997/01/18 17:26:39  curt
  329. # Added "use strict" pragma to enforce good scoping habits.
  330. #
  331. # Revision 2.5  1996/10/03 04:49:08  curt
  332. # Fixed an inconsistency in &raw_date() in common.pl (with how it was
  333. # called.)
  334. #
  335. # Version now is 0.67-beta-x
  336. #
  337. # Revision 2.4  1996/10/03 03:53:42  curt
  338. # CBB now determines the current century automatically ... no need for it
  339. # to be hard coded.  Removed all hardcoded instances of the century (especially
  340. # in reports.pl and recur.pl)
  341. #
  342. # Added an optional --debug flag to the invocation of CBB.
  343. #
  344. # Revision 2.3  1996/09/17 19:41:10  curt
  345. # Add support for recurring transfer transactions.
  346. #
  347. # Revision 2.2  1996/07/13 02:58:24  curt
  348. # Misc. changes.
  349. #
  350. # Revision 2.1  1996/02/27  05:36:04  curt
  351. # Just stumbling around a bit with cvs ... :-(
  352. #
  353. # Revision 2.0  1996/02/27  04:43:14  curt
  354. # Initial 2.0 revision.  (See "Log" files for old history.)
  355.