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

Text File | 1998-10-07 | 7.0 KB | 251 lines

#!/usr/bin/perl
#
# Christopher B. Browne, [e-mail], [e-mail]
# Web: http://www.conline.com/~cbbrowne  SAP Basis Consultant, UNIX Guy
# Windows NT - How to make a 100 MIPS Linux workstation perform like an 8 MHz
# 286
#
# $Id: txn,v 2.2 1997/07/02 18:36:57 curt Exp $

$name = shift(@ARGV); $name =~ tr/A-Z/a-z/;
$homedir = "/home/cbbrowne/kwiken/";

# find the *real* file name (with lots of chances to die if it's not a
# particularly valid name)
$datafile = &find_cbb_file($name, $homedir);

# See if the file is really and truly a CBB data file
&die_if_not_cbb($datafile);

# initial error checking:
if ($#ARGV != 5) {
   &report_bad_args($#ARGV);
   die(-1);
}

($indate, $check, $payee, $cat, $amount, $desc) = @ARGV;

$txndate = &fiddle_with_date($indate);

if ($amount < 0) {
    $credit = sprintf("%.2f", -$amount);
    $debit=0.0;
} else {
    $debit = sprintf("%.2f", $amount);
    $credit=0.0;
}

#$newbal = sprintf("%.2f", $lastbal + $credit - $debit);

# Check the category/categories
$cat = &split_txn($cat, $amount);
if ($cat eq "-1" || $cat eq "") {
    print "Did not exist!\n";
    die -1;
}

$rec = "";

$txn = "$txndate\t$check\t$payee\t$debit\t$credit\t$cat\t$desc\t$rec";

open(OUT, ">>$datafile");
print OUT $txn, "\n";
close(OUT);

print "Added to $datafile\n";
print "$txn\n";
#print "New balance: $newbal\n";

exit 0;

############################################################
############################################################
############################################################

sub split_txn {
    local ($scat, $amount, $total) = @_;
    if (index($scat, "|", 0) != -1) {
    # Split transaction; look for the pieces, see if they add up
    @PIECES=split(/\|/, $scat);
    if (($#PIECES % 2) == 1) {
        print "Split does not have appropriate number of pieces\n";
        die -1;
    }
    @SPLIT = ();  # Initialize the result array
    shift(@PIECES);  # First item gets trashed
    while (@PIECES) {
        $scat = &find_cats(shift(@PIECES));
        $samount = &remove_commas(shift(@PIECES));
        push(@SPLIT, $scat);
        push(@SPLIT, $samount);
        $total -= $samount;
        if (substr($scat, 0, 1) eq "[") {
        # This is a transfer inside a split
        $tftxn = "txn '$scat' '$txndate' '$check' 'Funds Transfer (split)' '[$name]'
$samount '$desc'";
        push(@TFTXNS, $tftxn);
        }
    }
    if ((($total - $amount) > 0.005) || (($total - $amount) < -0.005)) {
        printf "Split amounts add up to %.2f; not the same as the total %.2f\n",
        $total, $amount;
        die -1;
    } else {
        # Re-assemble the string using what was determined here
        $scat = "|".join("|", @SPLIT);
        while (@TFTXNS) {
        system (pop(@TFTXNS));
        }
    }
    } else {
    $scat = &find_cats($scat);
    }
    return $scat;
}


sub find_cats {
    local ($category) = @_;
    $category =~ tr/A-Z/a-z/;
    local (@MATCH, $lowkey, $key, $value);

    # Search the category list for matches.  If only one is found, then
    # return it as $cat.  If more than one is found, put them in @MATCH.
    # $lowkey is used for the search, so that it's all case insensitive

    $categoryfile = $homedir."categories";
    $match = `grep -i "$category" $categoryfile`;
    @MATCH=();
    @FOUND = split(/\n/, $match);
    foreach $line (0..$#FOUND) {
    ($key, $value) = split(/\t/, $FOUND[$line]);
    print "[$key] [$value]\n";
        $lowkey = $key;
    $lowkey =~ tr/A-Z/a-z/;
        push(@MATCH,$key);
    }

    # Now, see if the category is valid...
    if ($#MATCH == -1) {
    print "No matches found for $category!\n";
    return -1;
    } elsif ($#MATCH == 0) {
#    print "Ok - found $category\n";
    return $MATCH[0];
    } else {
    print "Transaction dated [$txndate]  Ref # [$check] to [$payee]\n";
        printf "Amount: DR %12.2f CR %12.2f Re: %s\n", $debit, $credit, $desc;
    print "\nCategory code [$category] is ambiguous:\n";
    printf " #  Category Name      Long Description\n";
        printf "----------------------------------------------------------\n";
    foreach $i (0..$#MATCH) {
        printf "%2d %-20s %s\n", $i, $MATCH[$i], $CATS{$MATCH[$i]};
    }
    print "Pick one: (invalid entry to abort): ";
    $alt=<STDIN>;
    if (($alt > $#MATCH) || ($alt < 0)
        || ($alt lt 0) || ($alt gt "99")) {
        print "Invalid value - ABORT!";
        exit(-1);
    }
    else
    {
        return $MATCH[$alt];
    }
    }
}

sub die_if_not_cbb {
    local ($datafile) = @_;
    $head = `head -1 $datafile`;  # Grab the first line of the file
    if ($head =~ /CBB Data File --/) {
    # OK
    # Pre v0.70 - read the last line, and grab the last balance.
    # Post v0.70 - there is no "balance" field in the .cbb file to read.
    # $lasttxn = `tail -1 $datafile`;  # Grab the last line of the file
    # ($x1, $x2, $x3, $x4, $x5, $x6, $x7, $x8, $lastbal) = split(/\t/, $lasttxn);
    # $lastbal = sprintf("%.2f", $lastbal);
       return;
   } else {
       print $head;
       print "Data file $datafile doesn't look like it's a CBB file\n";
       die -1;
   }
}

sub find_cbb_file {
    local ($id, $homedir) = @_;
    local ($datafile) = $homedir.$id;
    if (!($datafile =~ /\.cbb/) ){
    $datafile .= ".cbb";
    }
    if (-e $datafile) {
     # Ok
    } else {
    print "Could not find file $datafile\n";
    die -1;
    }
    if (!( -w $datafile)) {
    print "You're not allowed to write to $datafile!\n";
    die -1;
    }
   return $datafile;
}

sub report_bad_args {
    local ($nargs) = @_;
    print "incorrect argument count - [$nargs]\n";
    print "txn  [Source_acct]  [Date]  [Ref#]  [Payee]  [Category]  [Amount]
[Comment]\n\n";
    print "    Adds a financial transaction to a cbb file\n";
    print "    use '-t' to fill in today's date\n\n";
    print "Example:\n  dantzig[90]> txn cash -t 'n/a' '1st Cdn Place' 'Lunch'
4.27 ''\n";
}

sub fiddle_with_date {
    local ($indate) = @_;
    local($g,$g,$g,$day,$month,$year,$g,$g,$g)=localtime(time);
    local($todaydate) = sprintf ("%02d%02d%02d", $year, $month+1,
                 $day+1);
    local ($txndate) = $indate;
    if ($txndate eq "-t") {
    $txndate = $todaydate;
    }

    # If the date is 2 digits, then the transaction is merely specifying
    # the day within this month.
    if (length($txndate) <= 2) {
    $txndate = substr($todaydate, 0, 4).sprintf("%02d", $txndate);
    }

# If the date is 4 digits long, then it's specifying date and month.
# Insert the year (just YY at this point).
    if (length($txndate) == 4) {
    $txndate = substr($todaydate, 0, 2).sprintf("%04d", $txndate);
    }


    $century = "19";        # In the year 2000, this will need to change.
    if (length($txndate) != 8) {
    $txndate = $century.$txndate;
    }

    local($year, $month, $day) = (substr($txndate, 0, 4),
                  substr($txndate, 4, 2),
                  substr($txndate, 6, 2));

# This really ought to consider the number of days in each month;
# e.g., February 30th never exists.  I haven't bothered.

# Now, validate a whack of stuff all at once, and die if everything
# doesn't seem correct.
    if ((length($txndate) != 8) || ($month < 1) || ($month > 12)
    || ($day < 1) || ($day > 31)) {
    print "Date [$txndate] formatted incorrectly - use YYYYMMDD\n";
    die -1;
    }

    return $txndate;
}