#!/usr/local/bin/perl
#  categories.pl - functions to implement categories
#
#  Written by Curtis Olson.  Started September 29, 1994.
#
#  Copyright (C) 1994 - 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: categories.pl,v 1.1.1.1 1999/12/18 02:04:46 curt Exp $


package CBB;

use strict;    # don't take no guff


# Global variables

# %CBB::CATS - an associative array of categories
# @CBB::CATKEYS - a sorted list of category keys (for traversing the cat list)
# $CBB::sorted_catkeys - specifies whether the list in @CBB::CATKEYS is valid


# initialize the categories list
sub init_cats {
    # out: result

    %CBB::CATS = ();
    $CBB::sorted_catkeys = 0;

    return "ok";
}


# set @CBB::CATKEYS = sorted list of transaction keys
sub sort_catkeys {
    $CBB::sorted_catkeys = 1;

    print DEBUG "sort_catkeys()\n" if $CBB::debug;
    @CBB::CATKEYS = sort(keys %CBB::CATS);
}


# edit a category in the category list
sub edit_cat {
    # in: category
    # out: category

    my($cat) = @_;
    my($key, $desc, $tax) = split(/\t/, $cat);

    $CBB::sorted_catkeys = 0;

    $CBB::CATS{$key} = "$desc\t$tax";

    print DEBUG "cat-edit:  $cat\n" if $CBB::debug;

    return "$cat";
}


# insert a category into the category list
sub insert_cat {
    # in: category
    # out: category

    my($cat) = @_;
    my($key, $desc, $tax) = split(/\t/, $cat);

    $CBB::sorted_catkeys = 0;

    $CBB::CATS{$key} = "$desc\t$tax";

    print DEBUG "cat-insert:  $cat\n" if $CBB::debug;

    return "$cat";
}


# delete a category from the category list
sub delete_cat {
    # in: category

    my($cat) = @_;
    my($key, $desc, $tax) = split(/\t/, $cat);

    $CBB::sorted_catkeys = 0;

    delete $CBB::CATS{$key};

    print DEBUG "cat-deleted:  $cat\n" if $CBB::debug;

    return "$cat";
}


# attempt to find a category matching the key
# incomplete keys are allowed
sub find_cat {
    # in: key
    # out: category

    my($key) = @_;
    my($result, $count, $i, $match, $catkey);

    if ($CBB::sorted_catkeys == 0) {
	&sort_catkeys();
    }

    if ( $key ne "" ) {
	# escape any '[' and ']' in $key
	$key =~ s/\[/\\\[/g;
	$key =~ s/\]/\\\]/g;
	print DEBUG "$key\n" if $CBB::debug;
	$count = 0;
	$match = 0;
        foreach $catkey (@CBB::CATKEYS) {
	    if ( $catkey =~ m/^$key/i ) {
		#print DEBUG "found $catkey\n" if $CBB::debug;
	        #return $catkey;

                $count++;
		print DEBUG "$catkey <=> $key\n" if $CBB::debug;
		if ($catkey =~ m/^$key$/i) {
		    print DEBUG "exact match $catkey <=> $key\n" if $CBB::debug;
		    $match = 1;
		}

                if ( length($result) ) {
                    $i = 0;
                    while ( $i < length($result) &&
                            substr("\U$result", $i, 1) eq 
                            substr("\U$catkey", $i, 1) ) {
                        $i++;
                    }                                          
                    $result = substr($result, 0, $i);
                } else {                              
                    $result = $catkey
                }
	    }
        }
        if ( length($result) && ($count == 1) ) {
            return "$result";
	} elsif ( $match ) {
	    return "$result";
        } elsif ( length($result) ) {
            return "partial_match:$result";
        }
    }

    print DEBUG "found none\n" if $CBB::debug;
    return "none";
}


# attempt to find a category matching the key
# incomplete keys are allowed
sub get_cat_info {
    # in: key
    # out: category description

    my($key) = @_;
    my($catkey);

    if ($CBB::sorted_catkeys == 0) {
	&sort_catkeys();
    }

    if ( $key ne "" ) {
	# escape any '[' and ']' in $key
	$key =~ s/\[/\\\[/g;
	$key =~ s/\]/\\\]/g;
	print DEBUG "$key\n" if $CBB::debug;
        foreach $catkey (@CBB::CATKEYS) {
	    if ( $catkey =~ m/^$key/i ) {
		print DEBUG "found $catkey = $CBB::CATS{$catkey}\n" 
		    if $CBB::debug;
	        return $CBB::CATS{$catkey};
	    }
        }
    }

    print DEBUG "found none\n" if $CBB::debug;
    return "none";
}


# returns the entire category list in one big chunk.
sub all_cats {
    # out: category list

    my($key);

    $| = 0;				# turn off buffer flushing

    if ($CBB::sorted_catkeys == 0) {
	&sort_catkeys();
    }

    foreach $key (@CBB::CATKEYS) {
	print ("$key\t$CBB::CATS{$key}\n");
    }

    $| = 1;				# turn buffer flushing back on

    return "none";
}


# load a categories list
sub load_dbm_cats {
    # in: file base name
    # out: result

    my($file) = @_;

    $CBB::sorted_catkeys = 0;

    dbmclose(%CBB::CATS);
    dbmopen(%CBB::CATS, $file, 0666);

    return "ok";
}


# load a categories list
sub load_cats {
    # in: file base name
    # out: result

    my($file) = @_;

    $CBB::sorted_catkeys = 0;

    open(LOADCATS, "<$file") || return "error";

    while ( <LOADCATS> ) {
	chop;
	if ( ! m/\t/ ) {
	    s/:/\t/g;
	}
	&insert_cat($_);
    }

    close(LOADCATS);

    return "ok";
}


# save the category list
sub save_cats {
    # in: file base name
    # out: result

    my($file) = @_;
    my($key);

    print DEBUG "save_cats to file $file\n" if $CBB::debug;

    if ($CBB::sorted_catkeys == 0) {
	&sort_catkeys();
    }

    open(SAVECATS, ">$file") || return "error";

    foreach $key (@CBB::CATKEYS) {
        print( SAVECATS "$key\t$CBB::CATS{$key}\n" );
    }

    close(SAVECATS);

    return "ok";
}


&init_cats();