#!/usr/local/bin/perl # recur.pl - Manage and update recurring transactions in a .cbb file. # # Written by Curtis Olson. Started January 16, 1996. # # Copyright (C) 1996 - 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: recur.pl,v 1.2 1999/12/30 05:40:50 curt Exp $ # (Log is kept at end of this file) use strict; # don't take no guff require "timelocal.pl"; package CBB; my($key, $date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total); my($recur, $result, $update); my($future_days, $secs_per_day, $cur_date, $account); # specify the installed location of the necessary pieces. $CBB::cbb_incl_dir = ".."; unshift(@INC, $CBB::cbb_incl_dir); require "memorized.pl"; require "categories.pl"; require "common.pl"; require "engine.pl"; ($#ARGV >= 0) || die "Usage: $0 account"; # how many days to plan ahead #$future_days = 366; # approximately 1 year; $future_days = 92; # approximately 3 months; $secs_per_day = 86400; # seconds per day; $cur_date = &raw_date; $account = shift(@ARGV); if ( $account !~ /\.cbb$/ ) { die "Account name must end in '.cbb'\n"; } (&load_trans($account) eq "ok") || die "Cannot open account: $account"; #----------------------------------------------------------------------- # Traverse all transactions and perform the following steps on entries with # $cleared = "?": # # 1. If date has passed, change $cleared to "!" # 2. If date is present or future, delete entry. These entries will be # reinserted later. #----------------------------------------------------------------------- print "Updating/deleting current recurring transactions: "; $result = &first_trans(); while ( $result ne "none" ) { ($key, $date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) = split(/\t/, $result); if ( $cleared eq "?" ) { if ( $date < $cur_date ) { # set $cleared to "!" # print "updating - $result\n"; print "."; $update = "$key\t$date\t$check\t$desc\t$debit\t$credit\t". "$cat\t$com\t!\t$total"; if ($cat =~ m/^\[/) { &update_xfer($update); } else { &update_trans($update); } } else { # delete # print "deleting - $result\n"; print "."; if ($cat =~ m/^\[/) { &delete_xfer($key); } else { &delete_trans($key); } } } $result = &next_trans(); } print "\n"; #----------------------------------------------------------------------- # Now add in all future recurring transactions #----------------------------------------------------------------------- print "Adding in future recurring transactions: "; # print "$account - " . &file_root($account) . "\n"; $recur = &file_root($account) . ".rcr"; # # print "$recur\n"; # open(RECUR, "<$recur") || die "Cannot open: $recur"; while ( ) { # print length($_) . " - $_"; if ( m/^#/ || ! m/\t/ ) { # ignore this line } else { # Ok, we found one! &add_all_recurs($_); } } close(RECUR); # Finally, save the result (&save_trans("$account") eq "ok") || die "Cannot save account: $account"; #----------------------------------------------------------------------- # Supporting Routines #----------------------------------------------------------------------- # Add all recuring transactions specified sub add_all_recurs { my($line) = @_; my($days, $months, $years, $desc, $debit, $credit, $com, $cat, $begindate, $cutoff); my($date, $dates, $key, $trans, @DATES); chop($line); ($days, $months, $years, $desc, $debit, $credit, $com, $cat, $begindate, $cutoff) = split(/\t/, $line); if ( ($begindate eq "") || ($begindate < $cur_date) ) { $begindate = $cur_date; } if ( $cutoff eq "" ) { $cutoff = &calc_cutoff(); } # print "cutoff = $cutoff\n"; if ( ($days < 32) || ($days =~ m/,/) || ($days eq "*") ) { # type 1 recurring transaction $dates = &gen_dates_1($days, $months, $years, $begindate, $cutoff); # print "$dates\n"; } else { # type 2 recurring transaction $dates = &gen_dates_2($days, $months, $years, $begindate, $cutoff); # print "$dates\n"; } @DATES = split(/,/, $dates); foreach $date (@DATES) { print "."; $trans = "$date\t\t$desc\t$debit\t$credit\t$cat\t$com\t?\t"; if ($cat =~ m/^\[/) { $key = &create_xfer($trans); } else { $key = &create_trans($trans); } } } print "\n"; # Calculate cutoff date sub calc_cutoff { my($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = localtime(time); my($cutoff_secs, $today_secs); # print "calling timelocal with cmon = $cmon\n"; $today_secs = &main'timelocal(0, 0, 0, $cmday, $cmon, $cyear); $cutoff_secs = $today_secs + ($future_days * $secs_per_day); ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = localtime($cutoff_secs); $cyear += 1900; return $cyear . &pad($cmon + 1) . &pad($cmday); } # Generate a list of type 1 dates sub gen_dates_1 { my($days, $months, $years, $begindate, $cutoff) = @_; my($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = localtime(time); my($ldates) = ""; my($day, $month, $year, $tdays, $tmonth, $tyear); my($this_date, $month_end, $next_month); my(@DAYS, @MONTHS, @YEARS); # print "$days - $months - $years\n"; if ( $months eq "*" ) { $months = "1,2,3,4,5,6,7,8,9,10,11,12"; } @MONTHS = split(/,/, $months); $cyear += 1900; if ( $years eq "*" ) { $years = "$cyear," . ($cyear+1); } @YEARS = split(/,/, $years); foreach $year (@YEARS) { $year = 1900 + $year if $year < 1900; foreach $month (@MONTHS) { # print $year . &pad($month) . "\n"; if ( $month == 12 ) { $tyear = $year + 1; $tmonth = 1; } else { $tyear = $year; $tmonth = $month + 1; } # note in perl the months start at 0 ... :( # print "calling timelocal with tmonth = $tmonth \n"; $next_month = &main'timelocal(0, 0, 0, 1, ($tmonth - 1), $tyear); # subtract the number of seconds in a day to get the last # day of the previous month $month_end = $next_month - $secs_per_day; ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = localtime($month_end); if ( $days eq "*" ) { $tdays = "1"; $day = 2; while ( $day <= $cmday ) { $tdays .= "," . $day; $day++; } } else { $tdays = $days; $tdays =~ s/last/$cmday/; } # print "$tdays\n"; @DAYS = split(/,/, $tdays); foreach $day (@DAYS) { $this_date = $year . &pad($month) . &pad($day); if ( ($this_date >= $begindate) && ($this_date <= $cutoff) ) { # print "$this_date\n"; if ( $ldates eq "" ) { $ldates = $this_date; } else { $ldates .= "," . $this_date; } } } } } return $ldates; } # Generate a list of type 2 dates sub gen_dates_2 { my($start, $incr, $junk, $begindate, $cutoff) = @_; my($ldates) = ""; my($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst); my($scentury, $syear, $smonth, $sday) = $start =~ /(\d\d)(\d\d)(\d\d)(\d\d)/; my($secs, $sincr, $start_secs, $this_date); # print "$syear - $smonth - $sday\n"; # print "calling timelocal with smonth = $smonth\n"; $start_secs = &main'timelocal(0, 0, 0, $sday, ($smonth - 1), $syear); $sincr = $incr * $secs_per_day; $secs = $start_secs; ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = localtime($secs); $this_date = 1900 + $cyear . &pad($cmon + 1) . &pad($cmday); while ( $this_date <= $cutoff ) { if ( $this_date >= $begindate ) { if ( $ldates eq "" ) { $ldates = $this_date; } else { $ldates .= "," . $this_date; } # print "$this_date\n"; } $secs += $sincr; ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = localtime($secs); $this_date = 1900 + $cyear . &pad($cmon + 1) . &pad($cmday); } return $ldates; } #---------------------------------------------------------------------------- # $Log: recur.pl,v $ # Revision 1.2 1999/12/30 05:40:50 curt # Yikes, not another Y2K bug! # # Revision 1.1.1.1 1999/12/18 02:06:10 curt # Start of 0.8 branch # # Revision 1.1 1999/12/17 19:21:02 curt # Added to repository. # # Revision 2.14 1999/11/21 00:48:02 curt # Tweaks to copyright dates and email address. # # Revision 2.13 1999/10/11 15:01:59 curt # Added some multi-lingal support. # Sort balance window multiple ways. # Fixed a Y2K bug in recur.pl. # # Revision 2.12 1999/02/02 16:42:13 curt # Preparations for 0.78. # More Y2K tweaks. # Added a contrib script to change currency throughout an entire account. # # Revision 2.11 1999/01/13 22:40:31 curt # Fixed a small bug in import_qif() relating to the logic of properly # reconstructing splits. # # Added a script to convert MYM files to CBB. Contributed by Brian # # # Added an Emacs "edb" interface to the contrib section. Provided by # Bob Newell # # Preserve owner, group, and permissions of CBB files # # Added a loan_recur.pl script from Michel Verdier which does the same # thing as loan.pl, but also generates recuring transactions for the # payments. # # Patch from Michel Verdier to help recur.pl better handle recurring # transfer transactions. # # Added initial support for binding an arbitrary math function to the # debit and credit fields in the main transaction editor section. This # is useful for doing things like currency conversions. You can enter # in one currency and then use a hot key to convert to your "canonical" # currency. # # Revision 2.10 1998/10/07 20:30:03 curt # Patches from Philippe Troin # # Revision 2.9 1998/08/14 14:28:44 curt # Added desc-pie graph. # Added option to eliminate splash screen. # Other misc. tweaks and bug fixes. # # Revision 2.8 1997/02/28 21:21:58 curt # Fixed some problems introduced by using "use strict" # # Revision 2.7 1997/02/19 18:09:09 curt # Fixed some residual oversites from switching to "use strict". # # Revision 2.6 1997/01/18 17:26:39 curt # Added "use strict" pragma to enforce good scoping habits. # # Revision 2.5 1996/10/03 04:49:08 curt # Fixed an inconsistency in &raw_date() in common.pl (with how it was # called.) # # Version now is 0.67-beta-x # # Revision 2.4 1996/10/03 03:53:42 curt # CBB now determines the current century automatically ... no need for it # to be hard coded. Removed all hardcoded instances of the century (especially # in reports.pl and recur.pl) # # Added an optional --debug flag to the invocation of CBB. # # Revision 2.3 1996/09/17 19:41:10 curt # Add support for recurring transfer transactions. # # Revision 2.2 1996/07/13 02:58:24 curt # Misc. changes. # # Revision 2.1 1996/02/27 05:36:04 curt # Just stumbling around a bit with cvs ... :-( # # Revision 2.0 1996/02/27 04:43:14 curt # Initial 2.0 revision. (See "Log" files for old history.)