lib/abbrev.pl

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