home *** CD-ROM | disk | FTP | other *** search
- #!/usr/bin/perl
- # categories.pl - functions to implement categories
- #
- # Written by Curtis Olson. Started September 29, 1994.
- #
- # Copyright (C) 1994 - 1997 Curtis L. Olson - curt@sledge.mn.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.
-
- # $Id: categories.pl,v 2.9 1997/01/18 03:28:40 curt Exp $
- # (Log is kept at end of this file)
-
-
- 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();
-
-
- # ----------------------------------------------------------------------------
- # $Log: categories.pl,v $
- # Revision 2.9 1997/01/18 03:28:40 curt
- # Added "use strict" pragma to enforce good scoping habits.
- #
- # Revision 2.8 1996/12/17 14:53:52 curt
- # Updated copyright date.
- #
- # Revision 2.7 1996/12/11 18:33:26 curt
- # Ran a spell checker.
- #
- # Revision 2.6 1996/10/22 21:51:10 curt
- # Tweaked tab completion just a bit more.
- #
- # Revision 2.5 1996/09/26 19:48:43 curt
- # Fixed some problems with the newly revamped tab completion code.
- #
- # Revision 2.4 1996/09/25 17:11:10 curt
- # Added some initial code to better handle tab completion.
- #
- # Revision 2.3 1996/07/13 02:57:34 curt
- # Version 0.65
- # Packing Changes
- # Documentation changes
- # Changes to handle a value in both debit and credit fields.
- #
- # Revision 2.2 1996/03/03 00:16:10 curt
- # Modified Files: cbb categories.pl wrapper.pl file.tk main.tk menu.tk
- # Added an account list at the bottom of the screen. Thanks to:
- # Cengiz Alaettinoglu <cengiz@ISI.EDU> for this great addition.
- #
- # Revision 2.1 1996/02/27 05:35:31 curt
- # Just stumbling around a bit with cvs ... :-(
- #
- # Revision 2.0 1996/02/27 04:41:46 curt
- # Initial 2.0 revision. (See "Log" files for old history.)
-