home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _333a575abf5ed717443594bbd211d62b < prev    next >
Text File  |  2000-03-15  |  2KB  |  82 lines
  1. package Text::Abbrev;
  2. require 5.005;        # Probably works on earlier versions too.
  3. require Exporter;
  4.  
  5. =head1 NAME
  6.  
  7. abbrev - create an abbreviation table from a list
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.     use Text::Abbrev;
  12.     abbrev $hashref, LIST
  13.  
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. Stores all unambiguous truncations of each element of LIST
  18. as keys in the associative array referenced by C<$hashref>.
  19. The values are the original list elements.
  20.  
  21. =head1 EXAMPLE
  22.  
  23.     $hashref = abbrev qw(list edit send abort gripe);
  24.  
  25.     %hash = abbrev qw(list edit send abort gripe);
  26.  
  27.     abbrev $hashref, qw(list edit send abort gripe);
  28.  
  29.     abbrev(*hash, qw(list edit send abort gripe));
  30.  
  31. =cut
  32.  
  33. @ISA = qw(Exporter);
  34. @EXPORT = qw(abbrev);
  35.  
  36. # Usage:
  37. #    abbrev \%foo, LIST;
  38. #    ...
  39. #    $long = $foo{$short};
  40.  
  41. sub abbrev {
  42.     my ($word, $hashref, $glob, %table, $returnvoid);
  43.  
  44.     if (ref($_[0])) {           # hash reference preferably
  45.       $hashref = shift;
  46.       $returnvoid = 1;
  47.     } elsif (ref \$_[0] eq 'GLOB') {  # is actually a glob (deprecated)
  48.       $hashref = \%{shift()};
  49.       $returnvoid = 1;
  50.     }
  51.     %{$hashref} = ();
  52.  
  53.     WORD: foreach $word (@_) {
  54.         for (my $len = (length $word) - 1; $len > 0; --$len) {
  55.         my $abbrev = substr($word,0,$len);
  56.         my $seen = ++$table{$abbrev};
  57.         if ($seen == 1) {        # We're the first word so far to have
  58.                         # this abbreviation.
  59.             $hashref->{$abbrev} = $word;
  60.         } elsif ($seen == 2) {  # We're the second word to have this
  61.                         # abbreviation, so we can't use it.
  62.             delete $hashref->{$abbrev};
  63.         } else {            # We're the third word to have this
  64.                         # abbreviation, so skip to the next word.
  65.             next WORD;
  66.         }
  67.     }
  68.     }
  69.     # Non-abbreviations always get entered, even if they aren't unique
  70.     foreach $word (@_) {
  71.         $hashref->{$word} = $word;
  72.     }
  73.     return if $returnvoid;
  74.     if (wantarray) {
  75.       %{$hashref};
  76.     } else {
  77.       $hashref;
  78.     }
  79. }
  80.  
  81. 1;
  82.