[Summary view] [Print] [Text view]

   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;