lib/Text/Abbrev.pm

   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;