#!/usr/bin/perl # $Id: category_engine,v 1.2 1996/01/15 22:05:20 lupus Exp lupus $ # Category engine for Xfinans. # "calling protocol", the following variables are expected to be set # in the $initFile or $userInitFile: # # $output determines what type of output is produced # (status or a listing of a single category) # $showNumber the category number to be listed when listing # of a single category is selected via $output # # $fromDate period in focus # $toDate period in focus $categoryFile="categories"; $initFile="_engine.init"; $userInitFile="variables"; $initialBalanceCalculated=0; &loadCategories(); # load category definitions from file require($initFile); # load and evaluate initialization code require($userInitFile); # load and evaluate # user initialization code if( $output==$transactionList ) { # print header printf("Date Trans# %-35s Amount Total\n", "Text"); } &loadTransactions(); # load and process the transactions # when the desired output is a trans.list, # output is printed during &loadTransactions(); if($output == $status) { # produce status output if required printf("Cat# %-28sBalances: Opening Closing Difference\n", "Category name"); # begin with a header foreach $catNum (sort numerically keys(%categoryName)) { printf("%04d %-33s %11.2f %11.2f %11.2f\n", $catNum, $categoryName{$catNum}, $initialBalance{$catNum}, $categoryBalance{$catNum}, $categoryBalance{$catNum}-$initialBalance{$catNum}); } } # subroutines ---------------- sub loadTransactions { while($entry=<>) { # read transactions from STDIN chop($entry); ($date, $transNum, $catNum, $text, $amount, $commit)=split(/;/, $entry); if(!$initialBalanceCalculated && $date>=$fromDate) { $initialBalanceCalculated=1; foreach $categNum (keys(%categoryName)) { $initialBalance{$categNum}=$categoryBalance{$categNum}; } } if($date>$toDate) { return; } &recursiveEnter($catNum, $date, $transNum, $text, $amount, $commit); } } sub enter { local($catNum, $date, $transNum, $text, $amount, $commit) = @_; $categoryBalance{$catNum}+=$amount; # print $catNum, " ", $categoryName{$catNum}, " ", $amount, " : ", $categoryBalance{$catNum}, "\n"; &makeOutput($catNum, $date, $transNum, $text, $amount, $commit); } sub recursiveEnter { local($catNum, $date, $transNum, $text, $amount, $commit) = @_; local($warning); # print join(' ', ($date, $transNum, $catNum, $text, $amount, $commit)), "\n"; if( $categoryDefinition{$catNum} ) { eval $categoryDefinition{$catNum}; if( $@ ) { &warn( $@ ); &warn("CODE CAUSING THE PROBLEM:\n"); &warn($categoryDefinition{$catNum}); &warn("\nWHICH IS FROM : category definition ".$catNum."\n----\n"); } } else { $warning="[category not found: ".$catNum.", trans.num: ".$transNum." ".$text."]\n"; &warn($warning); } } sub std_income { # enter the transaction without modification &enter($catNum, $date, $transNum, $text, $amount, $commit); } sub std_expense { # change the sign of the amount, to have positive numbers in the # category &enter($catNum, $date, $transNum, $text, -$amount, $commit); } sub copy_to { local($catN) = @_; &recursiveEnter($catN, $date, $transNum, $text, $amount, $commit); } sub makeOutput { local($catNum, $date, $transNum, $text, $amount, $commit) = @_; if( $output==$transactionList ) { if( $catNum==$showNumber && $date>=$fromDate ) { printf("%d %05d %-35s %11.2f %11.2f\n", $date, $transNum, $text, $amount, $categoryBalance{$catNum}-$initialBalance{$catNum}); } } } sub loadCategories { local($num, $name, $definition, $def); open(CATEGORIES, $categoryFile) || die "Couldn't open categories-file"; while($num=) { # for each entry in the categories-file" $name=; $definition=""; $def=; while( !($def =~ m/\#enddef/) ) { $definition.=$def; $def=; } chop($num); chop($name); # # print $num, "\n", $name, "\n", $definition; $categoryName{$num}=$name; # $categoryDefinition{$num}=$definition; $categoryBalance{$num}=0.0; } close CATEGORIES; } sub warn { local($message) = @_; print $message; } sub loadAndEvaluate { local($file) = @_; local($code, $line); if( !open(CODEFILE, $file) ) { &warn("Couldn't open file \n".$file); return; } while($line=) { $code.=$line; } close CODEFILE; # print $code; eval($code); if( $@ ) { &warn( $@ ); &warn("code causing the problem:\n"); &warn($code); } } sub numerically { $a <=> $b; } # subroutine used for numerical sort