lib/Text/Abbrev.pm

   1 package Text::Abbrev;
   2 require 5.000;
   3 require Exporter;
   4
   5 @ISA = qw(Exporter);
   6 @EXPORT = qw(abbrev);
   7
   8 # Usage:
   9 #       &abbrev(*foo,LIST);
  10 #       ...
  11 #       $long = $foo{$short};
  12
  13 sub abbrev {
  14     local(*domain) = shift;
  15     @cmp = @_;
  16     %domain = ();
  17     foreach $name (@_) {
  18         @extra = split(//,$name);
  19         $abbrev = shift(@extra);
  20         $len = 1;
  21         foreach $cmp (@cmp) {
  22             next if $cmp eq $name;
  23             while (substr($cmp,0,$len) eq $abbrev) {
  24                 $abbrev .= shift(@extra);
  25                 ++$len;
  26             }
  27         }
  28         $domain{$abbrev} = $name;
  29         while (@extra) {
  30             $abbrev .= shift(@extra);
  31             $domain{$abbrev} = $name;
  32         }
  33     }
  34 }
  35
  36 1;
  37