RE: Untested libraries update
[p5sagit/p5-mst-13.2.git] / lib / Text / Abbrev.pm
1 package Text::Abbrev;
2 require 5.005;          # Probably works on earlier versions too.
3 require Exporter;
4
5 our $VERSION = '1.00';
6
7 =head1 NAME
8
9 abbrev - create an abbreviation table from a list
10
11 =head1 SYNOPSIS
12
13     use Text::Abbrev;
14     abbrev $hashref, LIST
15
16
17 =head1 DESCRIPTION
18
19 Stores all unambiguous truncations of each element of LIST
20 as keys in the associative array referenced by C<$hashref>.
21 The values are the original list elements.
22
23 =head1 EXAMPLE
24
25     $hashref = abbrev qw(list edit send abort gripe);
26
27     %hash = abbrev qw(list edit send abort gripe);
28
29     abbrev $hashref, qw(list edit send abort gripe);
30
31     abbrev(*hash, qw(list edit send abort gripe));
32
33 =cut
34
35 @ISA = qw(Exporter);
36 @EXPORT = qw(abbrev);
37
38 # Usage:
39 #       abbrev \%foo, LIST;
40 #       ...
41 #       $long = $foo{$short};
42
43 sub abbrev {
44     my ($word, $hashref, $glob, %table, $returnvoid);
45
46     if (ref($_[0])) {           # hash reference preferably
47       $hashref = shift;
48       $returnvoid = 1;
49     } elsif (ref \$_[0] eq 'GLOB') {  # is actually a glob (deprecated)
50       $hashref = \%{shift()};
51       $returnvoid = 1;
52     }
53     %{$hashref} = ();
54
55     WORD: foreach $word (@_) {
56         for (my $len = (length $word) - 1; $len > 0; --$len) {
57             my $abbrev = substr($word,0,$len);
58             my $seen = ++$table{$abbrev};
59             if ($seen == 1) {       # We're the first word so far to have
60                                     # this abbreviation.
61                 $hashref->{$abbrev} = $word;
62             } elsif ($seen == 2) {  # We're the second word to have this
63                                     # abbreviation, so we can't use it.
64                 delete $hashref->{$abbrev};
65             } else {                # We're the third word to have this
66                                     # abbreviation, so skip to the next word.
67                 next WORD;
68             }
69         }
70     }
71     # Non-abbreviations always get entered, even if they aren't unique
72     foreach $word (@_) {
73         $hashref->{$word} = $word;
74     }
75     return if $returnvoid;
76     if (wantarray) {
77       %{$hashref};
78     } else {
79       $hashref;
80     }
81 }
82
83 1;