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