Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

87 lines
1.6 KiB

  1. package Text::Abbrev;
  2. require 5.000;
  3. require Exporter;
  4. =head1 NAME
  5. abbrev - create an abbreviation table from a list
  6. =head1 SYNOPSIS
  7. use Text::Abbrev;
  8. abbrev $hashref, LIST
  9. =head1 DESCRIPTION
  10. Stores all unambiguous truncations of each element of LIST
  11. as keys key in the associative array referenced to by C<$hashref>.
  12. The values are the original list elements.
  13. =head1 EXAMPLE
  14. $hashref = abbrev qw(list edit send abort gripe);
  15. %hash = abbrev qw(list edit send abort gripe);
  16. abbrev $hashref, qw(list edit send abort gripe);
  17. abbrev(*hash, qw(list edit send abort gripe));
  18. =cut
  19. @ISA = qw(Exporter);
  20. @EXPORT = qw(abbrev);
  21. # Usage:
  22. # &abbrev(*foo,LIST);
  23. # ...
  24. # $long = $foo{$short};
  25. sub abbrev {
  26. my (%domain);
  27. my ($name, $ref, $glob);
  28. if (ref($_[0])) { # hash reference preferably
  29. $ref = shift;
  30. } elsif ($_[0] =~ /^\*/) { # looks like a glob (deprecated)
  31. $glob = shift;
  32. }
  33. my @cmp = @_;
  34. foreach $name (@_) {
  35. my @extra = split(//,$name);
  36. my $abbrev = shift(@extra);
  37. my $len = 1;
  38. my $cmp;
  39. WORD: foreach $cmp (@cmp) {
  40. next if $cmp eq $name;
  41. while (substr($cmp,0,$len) eq $abbrev) {
  42. last WORD unless @extra;
  43. $abbrev .= shift(@extra);
  44. ++$len;
  45. }
  46. }
  47. $domain{$abbrev} = $name;
  48. while (@extra) {
  49. $abbrev .= shift(@extra);
  50. $domain{$abbrev} = $name;
  51. }
  52. }
  53. if ($ref) {
  54. %$ref = %domain;
  55. return;
  56. } elsif ($glob) { # old style
  57. local (*hash) = $glob;
  58. %hash = %domain;
  59. return;
  60. }
  61. if (wantarray) {
  62. %domain;
  63. } else {
  64. \%domain;
  65. }
  66. }
  67. 1;