PC World 2000 February/PCWorld_2000-02_cd.bin/live/usr/X11R6/lib/X11/cbb/contrib/trimold.pl

Perl Script | 1998-10-07 | 6KB | 180 lines

#!/usr/bin/perl
#  trimold.pl - move all cleared transactions to date out of account file.
#
#  warning:  This program is rather slow ... but hey, you only have
#            to run it occasionally and it gives the impression that
#            it is really working hard. :)
#
#  Written by Lionel Mallet (with pieces from Curtis Olson).
#
#  Copyright (C) 1997  Lionel Mallet  - [e-mail]
#
#  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: trimold.pl,v 2.2 1997/07/04 14:24:42 curt Exp $
# (Log is kept at end of this file)

package CBB;

use strict;

my($account, $base_account, $old_account, $olddir, %CL_TRANS);
my($description, $comment, $todate, $vst_category, $running_balance);
my($new_debit, $new_credit, $new_trans, $response, $result, $arg);
my($key, $date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total);
my($niceto, $last_date, $month, $day, $year);

# specify the installed location of the necessary pieces.
$CBB::cbb_incl_dir = "/usr/X11R6/lib/X11/cbb";
unshift(@INC, $CBB::cbb_incl_dir);

require "categories.pl";
require "engine.pl";
require "memorized.pl";
require "common.pl";

(($#ARGV >= 4) && ($#ARGV <= 6)) ||
    die "Usage: trimold.pl account -to mm/dd/[yy]yy -cat vst_category [ -d
old_dir ]";

$account = shift(@ARGV);
$base_account = &file_basename($account);
$olddir = ".";
%CL_TRANS = {};
$running_balance = 0.0;
$description = "Balance";
$comment = "Trimmed";

while ($#ARGV >= 0) {
    $arg = shift(@ARGV);
    if ( substr($arg, 0 , 1) eq "-" ) {
    if ( $arg eq "-to" ) {
        $niceto = shift(@ARGV);

        my($month, $day, $year) = split(/\//, $niceto);
        $month = &pad($month);
        $day = &pad($day);
        if ( defined($year) ) {
        $year = &pad($year);
        } else {
        $year = $CBB::cur_year;
        }
        $year = &pad($year);
        if ( length($year) == 2 ) {
        $year = ¢ury() . "$year";
        }
        $todate = "$year" . "$month" . "$day";
    } elsif ( $arg eq "-d" ) {
        $olddir = shift(@ARGV);
    } elsif ( $arg eq "-cat" ) {
        $vst_category = shift(@ARGV);
    }
    }
}

# check arguments
( defined($todate) && defined($vst_category) ) ||
    die "Usage: trimold.pl account -to mm/dd/[yy]yy -cat vst_category [ -d
old_dir ]";

$old_account = $olddir."/".&file_root($base_account)."_".
    $todate.".".&file_extension($base_account);

print "Trimming up to ".&fmt_date($todate)." into $old_account.\n\n";
print "This program will MOVE all cleared transactions to date from\n";
print "the specified account to the specified export file. These\n";
print "transactions WILL BE DELETED from the specified account.\n";
print "You are strongly encouraged to make BACKUPS of all your data\n";
print "before attempting to do this.\n\n";
print "Do you wish to continue?  (yes/no) ";

$response = <STDIN>;

if ( $response =~ m/yes/i ) {
    print "Ok, continuing...";
} else {
    die "Bailing out ... nothing was done to your data.\n";
}


(&load_trans($account) eq "ok") || die "\nCannot open account:  $account";

$result = &first_trans();
while ( $result ne "none" ) {
    my($key, $date, $check, $desc, $debit, $credit, $cat, $com, $cleared,
     $total) = split(/\t/, $result);

    last if ($date > $todate);
    if ( $cleared ne "x" ) {
    print "\nFound uncleared transaction on ".&fmt_date($date).
        ", won't go further!\n";
    last;
    }

    # keep some info
    $running_balance = $running_balance + $credit - $debit;
    $last_date = $date;

    $CL_TRANS{$key} = $CBB::TRANS{$key};
    print ".";

    # these two lines should be in that order or we may miss one transaction!!!
    $result = &next_trans();
    &delete_trans($key);
}

# create transaction to restore current balance
if ($running_balance < 0) {
    $new_debit = $running_balance * -1;
    $new_credit  = 0.00;
} else {
    $new_debit = 0.00;
    $new_credit = $running_balance;
}

# create new transaction to restore running balance
$new_trans = "$last_date\t\t$description (".&fmt_date($last_date).")\t".
    sprintf("%.2f", $new_debit)."\t".sprintf("%.2f", $new_credit).
    "\t$vst_category\t$comment\tx\t".sprintf("%.2f", $running_balance);
&create_trans($new_trans);

(&save_trans("$account") eq "ok") || die "Cannot save account:  $account";

# now create old transaction account
&init_trans;
%CBB::TRANS = %CL_TRANS;
(&save_trans("$old_account") eq "ok") ||
    die "Cannot save account:  $old_account";

print "Done.\n";

sub fmt_date {
    my($raw_date) = @_;
    my($year) = substr($raw_date, 2, 2);
    my($month) = substr($raw_date, 4, 2);
    my($day) = substr($raw_date, 6, 2);

    return("$month/$day/$year");
}

# ----------------------------------------------------------------------------
# $Log: trimold.pl,v $
# Revision 2.2  1997/07/04 14:24:42  curt
# Lionel Mallet upgraded to run in perl's strict mode.
#
# Revision 2.1  1997/05/07 01:17:50  curt
# Added contrib script "trimold.pl"
#