home *** CD-ROM | disk | FTP | other *** search
/ Enter 2000 February / Enter2_2.iso / live / usr / X11R6 / lib / X11 / cbb / categories.pl < prev    next >
Encoding:
Perl Script  |  1998-10-07  |  7.2 KB  |  330 lines

  1. #!/usr/bin/perl
  2. #  categories.pl - functions to implement categories
  3. #
  4. #  Written by Curtis Olson.  Started September 29, 1994.
  5. #
  6. #  Copyright (C) 1994 - 1997  Curtis L. Olson  - curt@sledge.mn.org
  7. #
  8. #  This program is free software; you can redistribute it and/or modify
  9. #  it under the terms of the GNU General Public License as published by
  10. #  the Free Software Foundation; either version 2 of the License, or
  11. #  (at your option) any later version.
  12. #
  13. #  This program is distributed in the hope that it will be useful,
  14. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. #  GNU General Public License for more details.
  17. #
  18. #  You should have received a copy of the GNU General Public License
  19. #  along with this program; if not, write to the Free Software
  20. #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. # $Id: categories.pl,v 2.9 1997/01/18 03:28:40 curt Exp $
  23. # (Log is kept at end of this file)
  24.  
  25.  
  26. package CBB;
  27.  
  28. use strict;    # don't take no guff
  29.  
  30.  
  31. # Global variables
  32.  
  33. # %CBB::CATS - an associative array of categories
  34. # @CBB::CATKEYS - a sorted list of category keys (for traversing the cat list)
  35. # $CBB::sorted_catkeys - specifies whether the list in @CBB::CATKEYS is valid
  36.  
  37.  
  38. # initialize the categories list
  39. sub init_cats {
  40.     # out: result
  41.  
  42.     %CBB::CATS = ();
  43.     $CBB::sorted_catkeys = 0;
  44.  
  45.     return "ok";
  46. }
  47.  
  48.  
  49. # set @CBB::CATKEYS = sorted list of transaction keys
  50. sub sort_catkeys {
  51.     $CBB::sorted_catkeys = 1;
  52.  
  53.     print DEBUG "sort_catkeys()\n" if $CBB::debug;
  54.     @CBB::CATKEYS = sort(keys %CBB::CATS);
  55. }
  56.  
  57.  
  58. # edit a category in the category list
  59. sub edit_cat {
  60.     # in: category
  61.     # out: category
  62.  
  63.     my($cat) = @_;
  64.     my($key, $desc, $tax) = split(/\t/, $cat);
  65.  
  66.     $CBB::sorted_catkeys = 0;
  67.  
  68.     $CBB::CATS{$key} = "$desc\t$tax";
  69.  
  70.     print DEBUG "cat-edit:  $cat\n" if $CBB::debug;
  71.  
  72.     return "$cat";
  73. }
  74.  
  75.  
  76. # insert a category into the category list
  77. sub insert_cat {
  78.     # in: category
  79.     # out: category
  80.  
  81.     my($cat) = @_;
  82.     my($key, $desc, $tax) = split(/\t/, $cat);
  83.  
  84.     $CBB::sorted_catkeys = 0;
  85.  
  86.     $CBB::CATS{$key} = "$desc\t$tax";
  87.  
  88.     print DEBUG "cat-insert:  $cat\n" if $CBB::debug;
  89.  
  90.     return "$cat";
  91. }
  92.  
  93.  
  94. # delete a category from the category list
  95. sub delete_cat {
  96.     # in: category
  97.  
  98.     my($cat) = @_;
  99.     my($key, $desc, $tax) = split(/\t/, $cat);
  100.  
  101.     $CBB::sorted_catkeys = 0;
  102.  
  103.     delete $CBB::CATS{$key};
  104.  
  105.     print DEBUG "cat-deleted:  $cat\n" if $CBB::debug;
  106.  
  107.     return "$cat";
  108. }
  109.  
  110.  
  111. # attempt to find a category matching the key
  112. # incomplete keys are allowed
  113. sub find_cat {
  114.     # in: key
  115.     # out: category
  116.  
  117.     my($key) = @_;
  118.     my($result, $count, $i, $match, $catkey);
  119.  
  120.     if ($CBB::sorted_catkeys == 0) {
  121.     &sort_catkeys();
  122.     }
  123.  
  124.     if ( $key ne "" ) {
  125.     # escape any '[' and ']' in $key
  126.     $key =~ s/\[/\\\[/g;
  127.     $key =~ s/\]/\\\]/g;
  128.     print DEBUG "$key\n" if $CBB::debug;
  129.     $count = 0;
  130.     $match = 0;
  131.         foreach $catkey (@CBB::CATKEYS) {
  132.         if ( $catkey =~ m/^$key/i ) {
  133.         #print DEBUG "found $catkey\n" if $CBB::debug;
  134.             #return $catkey;
  135.  
  136.                 $count++;
  137.         print DEBUG "$catkey <=> $key\n" if $CBB::debug;
  138.         if ($catkey =~ m/^$key$/i) {
  139.             print DEBUG "exact match $catkey <=> $key\n" if $CBB::debug;
  140.             $match = 1;
  141.         }
  142.  
  143.                 if ( length($result) ) {
  144.                     $i = 0;
  145.                     while ( $i < length($result) &&
  146.                             substr("\U$result", $i, 1) eq 
  147.                             substr("\U$catkey", $i, 1) ) {
  148.                         $i++;
  149.                     }                                          
  150.                     $result = substr($result, 0, $i);
  151.                 } else {                              
  152.                     $result = $catkey
  153.                 }
  154.         }
  155.         }
  156.         if ( length($result) && ($count == 1) ) {
  157.             return "$result";
  158.     } elsif ( $match ) {
  159.         return "$result";
  160.         } elsif ( length($result) ) {
  161.             return "partial_match:$result";
  162.         }
  163.     }
  164.  
  165.     print DEBUG "found none\n" if $CBB::debug;
  166.     return "none";
  167. }
  168.  
  169.  
  170. # attempt to find a category matching the key
  171. # incomplete keys are allowed
  172. sub get_cat_info {
  173.     # in: key
  174.     # out: category description
  175.  
  176.     my($key) = @_;
  177.     my($catkey);
  178.  
  179.     if ($CBB::sorted_catkeys == 0) {
  180.     &sort_catkeys();
  181.     }
  182.  
  183.     if ( $key ne "" ) {
  184.     # escape any '[' and ']' in $key
  185.     $key =~ s/\[/\\\[/g;
  186.     $key =~ s/\]/\\\]/g;
  187.     print DEBUG "$key\n" if $CBB::debug;
  188.         foreach $catkey (@CBB::CATKEYS) {
  189.         if ( $catkey =~ m/^$key/i ) {
  190.         print DEBUG "found $catkey = $CBB::CATS{$catkey}\n" 
  191.             if $CBB::debug;
  192.             return $CBB::CATS{$catkey};
  193.         }
  194.         }
  195.     }
  196.  
  197.     print DEBUG "found none\n" if $CBB::debug;
  198.     return "none";
  199. }
  200.  
  201.  
  202. # returns the entire category list in one big chunk.
  203. sub all_cats {
  204.     # out: category list
  205.  
  206.     my($key);
  207.  
  208.     $| = 0;                # turn off buffer flushing
  209.  
  210.     if ($CBB::sorted_catkeys == 0) {
  211.     &sort_catkeys();
  212.     }
  213.  
  214.     foreach $key (@CBB::CATKEYS) {
  215.     print ("$key\t$CBB::CATS{$key}\n");
  216.     }
  217.  
  218.     $| = 1;                # turn buffer flushing back on
  219.  
  220.     return "none";
  221. }
  222.  
  223.  
  224. # load a categories list
  225. sub load_dbm_cats {
  226.     # in: file base name
  227.     # out: result
  228.  
  229.     my($file) = @_;
  230.  
  231.     $CBB::sorted_catkeys = 0;
  232.  
  233.     dbmclose(%CBB::CATS);
  234.     dbmopen(%CBB::CATS, $file, 0666);
  235.  
  236.     return "ok";
  237. }
  238.  
  239.  
  240. # load a categories list
  241. sub load_cats {
  242.     # in: file base name
  243.     # out: result
  244.  
  245.     my($file) = @_;
  246.  
  247.     $CBB::sorted_catkeys = 0;
  248.  
  249.     open(LOADCATS, "<$file") || return "error";
  250.  
  251.     while ( <LOADCATS> ) {
  252.     chop;
  253.     if ( ! m/\t/ ) {
  254.         s/:/\t/g;
  255.     }
  256.     &insert_cat($_);
  257.     }
  258.  
  259.     close(LOADCATS);
  260.  
  261.     return "ok";
  262. }
  263.  
  264.  
  265. # save the category list
  266. sub save_cats {
  267.     # in: file base name
  268.     # out: result
  269.  
  270.     my($file) = @_;
  271.     my($key);
  272.  
  273.     print DEBUG "save_cats to file $file\n" if $CBB::debug;
  274.  
  275.     if ($CBB::sorted_catkeys == 0) {
  276.     &sort_catkeys();
  277.     }
  278.  
  279.     open(SAVECATS, ">$file") || return "error";
  280.  
  281.     foreach $key (@CBB::CATKEYS) {
  282.         print( SAVECATS "$key\t$CBB::CATS{$key}\n" );
  283.     }
  284.  
  285.     close(SAVECATS);
  286.  
  287.     return "ok";
  288. }
  289.  
  290.  
  291. &init_cats();
  292.  
  293.  
  294. # ----------------------------------------------------------------------------
  295. # $Log: categories.pl,v $
  296. # Revision 2.9  1997/01/18 03:28:40  curt
  297. # Added "use strict" pragma to enforce good scoping habits.
  298. #
  299. # Revision 2.8  1996/12/17 14:53:52  curt
  300. # Updated copyright date.
  301. #
  302. # Revision 2.7  1996/12/11 18:33:26  curt
  303. # Ran a spell checker.
  304. #
  305. # Revision 2.6  1996/10/22 21:51:10  curt
  306. # Tweaked tab completion just a bit more.
  307. #
  308. # Revision 2.5  1996/09/26 19:48:43  curt
  309. # Fixed some problems with the newly revamped tab completion code.
  310. #
  311. # Revision 2.4  1996/09/25 17:11:10  curt
  312. # Added some initial code to better handle tab completion.
  313. #
  314. # Revision 2.3  1996/07/13 02:57:34  curt
  315. # Version 0.65
  316. # Packing Changes
  317. # Documentation changes
  318. # Changes to handle a value in both debit and credit fields.
  319. #
  320. # Revision 2.2  1996/03/03  00:16:10  curt
  321. # Modified Files:  cbb categories.pl wrapper.pl file.tk main.tk menu.tk
  322. #   Added an account list at the bottom of the screen.  Thanks to:
  323. #   Cengiz Alaettinoglu <cengiz@ISI.EDU> for this great addition.
  324. #
  325. # Revision 2.1  1996/02/27  05:35:31  curt
  326. # Just stumbling around a bit with cvs ... :-(
  327. #
  328. # Revision 2.0  1996/02/27  04:41:46  curt
  329. # Initial 2.0 revision.  (See "Log" files for old history.)
  330.