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     local($[) = 0;
  14     foreach $name (@_) {
  15         @extra = split(//,$name);
  16         $abbrev = shift(@extra);
  17         $len = 1;
  18         foreach $cmp (@cmp) {
  19             next if $cmp eq $name;
  20             while (@extra && substr($cmp,0,$len) eq $abbrev) {
  21                 $abbrev .= shift(@extra);
  22                 ++$len;
  23             }
  24         }
  25         $domain{$abbrev} = $name;
  26         while ($#extra >= 0) {
  27             $abbrev .= shift(@extra);
  28             $domain{$abbrev} = $name;
  29         }
  30     }
  31 }
  32
  33 1;