#!/usr/bin/perl
# $Id: cbbshutils.pl,v 1.2 1994/11/14 06:48:29 cbbrowne Exp cbbrowne $
# Here's some "standard things" that don't take significant time/space to
# load, and will be pretty universally useful.

# $home is where the data is.  This will have to be customized for YOUR
# installation; pick a favorite directory!
$home="/home/cbbrowne/business/quicken/dat/";

#  Written by Christopher B. Browne
#
#  Copyright (C) 1994  Christopher B. Browne cbrowne@io.org
#
#  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.

&load_cats($home."categories");

# Make sure that the transaction file is open to the current "account"
sub need_txn {
    local ($name) = $_[0];
    if ($name eq "") {
	print "No account specified!\n";
	die -1;
    }
    dbmopen(%ACCTLST, $home."acclist", 0666);
    $an=$ACCTLST{$name};
    if ($an eq "") {
	printf "Account [$name] does not exist!  Value=[%s]\n", $an;
	die -1;
    }
    $file = $home.$name.".txn";
    dbmopen(%TXNS, $file, 0666);
    return "ok";
}

sub need_os { # Ensure that the OS list is up to date
    local ($name) = $_[0];
    if (!(-e $home."$name.os.pag")) {
        system("buildos $name");
    }
    dbmopen(%OSLIST, $home."$name.os", 0666);
    return "ok";
}

sub need_bal { # Ensure that the balance list is new enough
    local ($name) = $_[0];
    if (!(-e $home."$name.bal.pag")) {
        system("buildos $name");
    }
    dbmopen(%BALS, $home."$name.bal", 0666);
}

sub blank_os {
    local ($name) = $_[0];
    $oscount = 0.0;
    dbmclose(%OSLIST);
    system("rm -f $home$name.os.*");
    dbmopen(%OSLIST, $home."$name.os", 0666);
}

sub blank_bal {
    local ($name) = $_[0];
    dbmclose(%BALS);
    system("rm -f $home$name.bal.*");
    dbmopen(%BALS, $home."$name.bal", 0666);
}

# get next available key for a specified date
sub get_next_key {
    local($date, $count) = (@_[0], 0);
    local($key)=sprintf( "%s-%02d", $date, $count);
    while (&get_TXNS($key)) {
        $count++;
        $key=sprintf( "%s-%02d", $date, $count);
    }
    return $key;
}

sub pad {
    return sprintf("%02d", @_[0]);
}

sub create_TXNS {
    # in: transaction
    # out: keyed_transaction
    local($trans, $caller) = @_;
    local($sorted_keys, $calced) = ();
    ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, $total) =
        split(/:/, $trans);
    $key = &get_next_key($date);
    &put_TXNS($key, $trans, "add:$caller", "NULL", "", $debit-$credit);
    return "$key:ZZZZ:$trans";
}

sub add_os {
    local ($key, $txn) = @_;
    local ($date, $check, $desc, $debit, $credit, $cat, $com, $cleared, 
           $junk) = (split(/:/, $txn));
    local ($okey) = "$check:$date:$key";
    if ($cleared ne "X") {
        $OSLIST{$okey} = $key unless ($cleared eq "X");
    }
}

sub notfound {
  printf "%s file not found for account %s.  You may have misspelled\nit, or have not created it yet.\n",
  $_[1], $_[0];
}

sub construct_sorted_os_list {
    local($count, $key, $value) = (0, "", "");
    local (@LST) = ();
    while (($key, $value)=each %OSLIST) {
        $LST[$count] = $key;
        $count++;
    }
    return sort @LST;
}

sub nice_date {
    local($year, $month, $day) = (substr($date, 0, 4), 
                                  substr($date, 4, 2),
                                  substr($date, 6, 2));
    return sprintf("%04d/%d/%d", ($year, $month, $day));
}

sub listtxn {
    local ($key, $value, $pos, $total, @SPLIT) = @_;
    local($date, $check, $desc, $debit, $credit, $cat, $com, 
	  $cleared, $total) = split(/:/, $value);
    local($nicedate) = (&nice_date($date));
    local ($split) = (substr($cat, 0, 1) eq "\|");
    if ($split) {
	@SPLIT = split(/\|/, $cat);
	$cat = $SPLIT[1]." (Split)";
    }
    write STDOUT;
    if ($split) {
	# Need to display the split
	shift(@SPLIT);		# Trash the non-existent first item
	$total = 0;
	while (@SPLIT) {
	    $cat = shift(@SPLIT);
	    $amount = shift(@SPLIT);
	    # Remove commas from the amounts.
            $amount = &remove_commas($amount);
	    printf "        Split: %35s  %12.2f\n", $cat, $amount;
	    $total += $amount;
	}
	printf "        Total of split:                             %12.2f\n", $total;
	print "_______________________________________________________________________\n";

    }
}

format STDOUT =
@### @<<<<<<<<<< @>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @> @######.## DR
$ky, $nicedate, $check, $desc,  $cleared, $debit
@>>>>>>>>>>>>>>>     @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @######.## CR
$cat, $com, $credit
_______________________________________________________________________
.

sub list_bals {
    $x = "X"; 
    $countkey = $x."count"; 
    $amtkey = $x."amount"; 
    printf STDOUT "%55s %4d %10.2lf\n", 
    "Previously Reconciled Balance:",
    $BALS{$countkey}, $BALS{$amtkey}; 
    $x = "*"; 
    $countkey = $x."count";
    $amtkey = $x."amount"; 
    printf STDOUT "%55s %4d %10.2lf\n", 
    "Items marked for current reconciliation:", 
    $BALS{$countkey}, $BALS{$amtkey}; 
    $x = "N";
    $countkey = $x."count"; 
    $amtkey = $x."amount"; 
    printf STDOUT "%55s %4d %10.2lf\n", "Items not yet marked:", $BALS{$countkey},
    $BALS{$amtkey};	     
    $x = "D";
    $countkey = $x."count"; 
    $amtkey = $x."amount"; 
    printf STDOUT "%55s %4d %10.2lf\n", "Items marked for deletion:", $BALS{$countkey},
    $BALS{$amtkey};	     
    
    close STDOUT;
}

sub log_txn {
    local ($key, $value, $desc) = @_;
    open(LOG, ">>$home"."alltxns.log");
    print LOG &log_entry($name, $key, $value, $desc);
    close(LOG);
}

# Format of log item is:
# [modtime]===[account]===[key]===[value]===[comment]
sub log_entry {
  local ($file, $key, $value, $comment) = @_;
  local ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) 
	= localtime(time);
  local ($now) = sprintf("%04d/%02d/%02d %02d:%02d:%02d", $year, $mon+1, 
  			 $mday+1, $hour, $min, $sec);
  sprintf ("%s===%s===%s===%s===%s\n", $now, $file, $key, $value, 
  	   $comment);
}

# This is used to create accounts
sub create_account {
   local ($name, $description) = @_;
   if (-e "$name.txn.pag")
   {
      print "Warning: DBM file already exists for this account; account already exists.\n";
      print "I'm NOT going to blow the old one away, but I will change its name\n";
      print "in the category file.  If you want the old one to disappear, you'll\n";
      print "have to blow it away yourself.\n";
      print "  The command would be something like:\n";
      print "  rm $name.txn.*\n";
   }

   # Everything is ok; create the account, and put an entry in the "category"
   # database
   dbmopen(%TXNS, $name.".txn", 0666);
   $CATS{"[$name]"} = "$description:";
} 

sub insert_cat {
    local ($catname, $catdesc, $tax) = split(/:/, $_[0]);
    $sorted_catkeys = 0;
    $CATS{"$catname"} = "$catdesc:$tax";
    printf DEBUG "cat-deleted:  %s\n", $_[0] if $debug;
    return $_[0];
}

sub delete_cat {
    local($key, $desc, $tax) = split(/:/, $_[0]);
    $sorted_catkeys = 0;
    delete $CATS{$key};
    printf DEBUG "cat-deleted:  %s\n", $_[0] if $debug;
    return $_[0];
}

sub load_cats {
    # in: file base name
    # out: result
    local($file) = @_;
    $sorted_catkeys = 0;
    dbmopen(%CATS, $file, 0666);
    return "ok";
}

sub get_OSLIST {
  return $OSLIST{$_[0]};
}

sub put_OSLIST {
    $OSLIST{$_[0]} = $_[1];
}

sub get_TXNS {
    # The "local" code is here so that any transactions that have the old
    # date format (yymmdd) will get updated as they're read in.
    local ($value, $key) = $TXNS{$_[0]}, $_[0];
    local ($date, $check, $desc, $debit, $credit, $cat, $com, 
	   $cleared, $total) = split(/:/, $trans);
    if (length($date) == 6) {
	print "Updating!\n";
	$date = "19$date";
	&put_TXNS($key, "$date:$check:$desc:$debit:$credit:$cat:$com:$cleared:$total::", "Fix Date", $cleared, $cleared, 0);
    }


    return $TXNS{$_[0]};
}

# Use this to update
sub put_TXNS {
  local($key, $value, $cause, $oldtag, $newtag, $amount) = @_;
  $TXNS{$key} = $value;				# Update dbm file
  &log_txn($key, $value, $cause);		# Log the transaction
  &adj_bals($oldtag, $newtag, $amount);		# Adjust the balances
}

sub del_TXNS {
  local ($key, $value, $tag, $amount) = @_;
  delete($TXNS{$key});
  &log_txn($key, $value, "Full Deletion");
  &adj_bals($tag, "NULL", $amount);
}

sub adj_bals {
   local ($oldtag, $newtag, $amount) = @_;
   &need_bal($name);
   if ($oldtag ne "NULL") {
      if ($oldtag eq "") { $oldtag = "N"; }
      $BALS{$oldtag."amount"} += $amount;
      $BALS{$oldtag."count"} --;
   }
   if ($newtag ne "NULL") {
      if ($newtag eq "") { $newtag = "N"; }
      $BALS{$newtag."amount"} -= $amount;
      $BALS{$newtag."count"} ++;
   }
}

sub zeroth_TXNS {}	# Null, in this case.
sub next_TXNS {return each (TXNS);}

sub remove_commas {
   local($amount, $pos) = (@_);
   while (($pos = index($amount, ",", 0) >= 0)) {
      substr($amount, $pos, 1) = "";
   }
   return $amount;
}

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

    # 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
    @MATCH=();
    while (($key, $value) = each %CATS) {
    	$lowkey = $key;
	$lowkey =~ tr/A-Z/a-z/;
	if (index($lowkey, $category, 0) == 0) {
	    push(@MATCH,$key);
	}
    }
    
    # Now, see if the category is valid...
    if ($#MATCH == -1) {
	print "No matches found for $category!\n";
	exit(-1);
    } elsif ($#MATCH == 0) {
	print "Ok - found $category\n";
	return $MATCH[0];
    } else {
	print "Transaction dated [$tdate]  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];
	}
    }
}
1;  # Need to return a "true" value
