home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl502b.zip / lib / Text / Abbrev.pm next >
Text File  |  1995-05-25  |  973b  |  60 lines

  1. package Text::Abbrev;
  2. require 5.000;
  3. require Exporter;
  4.  
  5. =head1 NAME
  6.  
  7. abbrev - create an abbreviation table from a list
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.     use Abbrev;
  12.     abbrev *HASH, LIST
  13.  
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. Stores all unambiguous truncations of each element of LIST
  18. as keys key in the associative array indicated by C<*hash>.
  19. The values are the original list elements.
  20.  
  21. =head1 EXAMPLE
  22.  
  23.     abbrev(*hash,qw("list edit send abort gripe"));
  24.  
  25. =cut
  26.  
  27. @ISA = qw(Exporter);
  28. @EXPORT = qw(abbrev);
  29.  
  30. # Usage:
  31. #    &abbrev(*foo,LIST);
  32. #    ...
  33. #    $long = $foo{$short};
  34.  
  35. sub abbrev {
  36.     local(*domain) = shift;
  37.     @cmp = @_;
  38.     %domain = ();
  39.     foreach $name (@_) {
  40.     @extra = split(//,$name);
  41.     $abbrev = shift(@extra);
  42.     $len = 1;
  43.     foreach $cmp (@cmp) {
  44.         next if $cmp eq $name;
  45.         while (substr($cmp,0,$len) eq $abbrev) {
  46.         $abbrev .= shift(@extra);
  47.         ++$len;
  48.         }
  49.     }
  50.     $domain{$abbrev} = $name;
  51.     while (@extra) {
  52.         $abbrev .= shift(@extra);
  53.         $domain{$abbrev} = $name;
  54.     }
  55.     }
  56. }
  57.  
  58. 1;
  59.  
  60.