home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / lib / abbrev.pl next >
Perl Script  |  1999-07-25  |  838b  |  44 lines
  1. ;# Usage:
  2. ;#    %foo = ();
  3. ;#    &abbrev(*foo,LIST);
  4. ;#    ...
  5. ;#    $long = $foo{$short};
  6.  
  7. #
  8. # This library is no longer being maintained, and is included for backward
  9. # compatibility with Perl 4 programs which may require it.
  10. #
  11. # In particular, this should not be used as an example of modern Perl
  12. # programming techniques.
  13. #
  14. # Suggested alternative: Text::Abbrev
  15. #
  16.  
  17. package abbrev;
  18.  
  19. sub main'abbrev {
  20.     local(*domain) = @_;
  21.     shift(@_);
  22.     @cmp = @_;
  23.     local($[) = 0;
  24.     foreach $name (@_) {
  25.     @extra = split(//,$name);
  26.     $abbrev = shift(@extra);
  27.     $len = 1;
  28.     foreach $cmp (@cmp) {
  29.         next if $cmp eq $name;
  30.         while (@extra && substr($cmp,0,$len) eq $abbrev) {
  31.         $abbrev .= shift(@extra);
  32.         ++$len;
  33.         }
  34.     }
  35.     $domain{$abbrev} = $name;
  36.     while ($#extra >= 0) {
  37.         $abbrev .= shift(@extra);
  38.         $domain{$abbrev} = $name;
  39.     }
  40.     }
  41. }
  42.  
  43. 1;
  44.