home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / Abbrev.pm < prev    next >
Encoding:
Perl POD Document  |  2003-11-07  |  2.0 KB  |  85 lines
  1. package Text::Abbrev;
  2. require 5.005;        # Probably works on earlier versions too.
  3. require Exporter;
  4.  
  5. our $VERSION = '1.01';
  6.  
  7. =head1 NAME
  8.  
  9. abbrev - create an abbreviation table from a list
  10.  
  11. =head1 SYNOPSIS
  12.  
  13.     use Text::Abbrev;
  14.     abbrev $hashref, LIST
  15.  
  16.  
  17. =head1 DESCRIPTION
  18.  
  19. Stores all unambiguous truncations of each element of LIST
  20. as keys in the associative array referenced by C<$hashref>.
  21. The values are the original list elements.
  22.  
  23. =head1 EXAMPLE
  24.  
  25.     $hashref = abbrev qw(list edit send abort gripe);
  26.  
  27.     %hash = abbrev qw(list edit send abort gripe);
  28.  
  29.     abbrev $hashref, qw(list edit send abort gripe);
  30.  
  31.     abbrev(*hash, qw(list edit send abort gripe));
  32.  
  33. =cut
  34.  
  35. @ISA = qw(Exporter);
  36. @EXPORT = qw(abbrev);
  37.  
  38. # Usage:
  39. #    abbrev \%foo, LIST;
  40. #    ...
  41. #    $long = $foo{$short};
  42.  
  43. sub abbrev {
  44.     my ($word, $hashref, $glob, %table, $returnvoid);
  45.  
  46.     @_ or return;   # So we don't autovivify onto @_ and trigger warning
  47.     if (ref($_[0])) {           # hash reference preferably
  48.       $hashref = shift;
  49.       $returnvoid = 1;
  50.     } elsif (ref \$_[0] eq 'GLOB') {  # is actually a glob (deprecated)
  51.       $hashref = \%{shift()};
  52.       $returnvoid = 1;
  53.     }
  54.     %{$hashref} = ();
  55.  
  56.     WORD: foreach $word (@_) {
  57.         for (my $len = (length $word) - 1; $len > 0; --$len) {
  58.         my $abbrev = substr($word,0,$len);
  59.         my $seen = ++$table{$abbrev};
  60.         if ($seen == 1) {        # We're the first word so far to have
  61.                         # this abbreviation.
  62.             $hashref->{$abbrev} = $word;
  63.         } elsif ($seen == 2) {  # We're the second word to have this
  64.                         # abbreviation, so we can't use it.
  65.             delete $hashref->{$abbrev};
  66.         } else {            # We're the third word to have this
  67.                         # abbreviation, so skip to the next word.
  68.             next WORD;
  69.         }
  70.     }
  71.     }
  72.     # Non-abbreviations always get entered, even if they aren't unique
  73.     foreach $word (@_) {
  74.         $hashref->{$word} = $word;
  75.     }
  76.     return if $returnvoid;
  77.     if (wantarray) {
  78.       %{$hashref};
  79.     } else {
  80.       $hashref;
  81.     }
  82. }
  83.  
  84. 1;
  85.