contrib/perl5/lib/Text/Abbrev.pm

   1 package Text::Abbrev;
   2 require 5.000;
   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 key in the associative array referenced to 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 (%domain);
  43     my ($name, $ref, $glob);
  44
  45     if (ref($_[0])) {           # hash reference preferably
  46       $ref = shift;
  47     } elsif ($_[0] =~ /^\*/) {  # looks like a glob (deprecated)
  48       $glob = shift;
  49     }
  50     my @cmp = @_;
  51
  52     foreach $name (@_) {
  53         my @extra = split(//,$name);
  54         my $abbrev = shift(@extra);
  55         my $len = 1;
  56         my $cmp;
  57         WORD: foreach $cmp (@cmp) {
  58             next if $cmp eq $name;
  59             while (substr($cmp,0,$len) eq $abbrev) {
  60                 last WORD unless @extra;
  61                 $abbrev .= shift(@extra);
  62                 ++$len;
  63             }
  64         }
  65         $domain{$abbrev} = $name;
  66         while (@extra) {
  67             $abbrev .= shift(@extra);
  68             $domain{$abbrev} = $name;
  69         }
  70     }
  71     if ($ref) {
  72       %$ref = %domain;
  73       return;
  74     } elsif ($glob) {           # old style
  75       local (*hash) = $glob;
  76       %hash = %domain;
  77       return;
  78     }
  79     if (wantarray) {
  80       %domain;
  81     } else {
  82       \%domain;
  83     }
  84 }
  85
  86 1;
  87