lib/perl5/5.6.1/Text/Abbrev.pm

   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;