Commit | Line | Data |
---|---|---|
a0d0e21e | 1 | package Text::Abbrev; |
6d03d463 | 2 | require 5.005; # Probably works on earlier versions too. |
a0d0e21e LW |
3 | require Exporter; |
4 | ||
b75c8c73 MS |
5 | our $VERSION = '1.00'; |
6 | ||
f06db76b AD |
7 | =head1 NAME |
8 | ||
9 | abbrev - create an abbreviation table from a list | |
10 | ||
11 | =head1 SYNOPSIS | |
12 | ||
ac323e15 UP |
13 | use Text::Abbrev; |
14 | abbrev $hashref, LIST | |
f06db76b AD |
15 | |
16 | ||
17 | =head1 DESCRIPTION | |
18 | ||
19 | Stores all unambiguous truncations of each element of LIST | |
6d03d463 | 20 | as keys in the associative array referenced by C<$hashref>. |
f06db76b AD |
21 | The values are the original list elements. |
22 | ||
23 | =head1 EXAMPLE | |
24 | ||
ac323e15 UP |
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)); | |
f06db76b AD |
32 | |
33 | =cut | |
34 | ||
a0d0e21e LW |
35 | @ISA = qw(Exporter); |
36 | @EXPORT = qw(abbrev); | |
37 | ||
38 | # Usage: | |
6d03d463 | 39 | # abbrev \%foo, LIST; |
a0d0e21e LW |
40 | # ... |
41 | # $long = $foo{$short}; | |
42 | ||
43 | sub abbrev { | |
6d03d463 | 44 | my ($word, $hashref, $glob, %table, $returnvoid); |
ac323e15 UP |
45 | |
46 | if (ref($_[0])) { # hash reference preferably | |
6d03d463 GS |
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; | |
a0d0e21e LW |
68 | } |
69 | } | |
a0d0e21e | 70 | } |
6d03d463 GS |
71 | # Non-abbreviations always get entered, even if they aren't unique |
72 | foreach $word (@_) { | |
73 | $hashref->{$word} = $word; | |
ac323e15 | 74 | } |
6d03d463 | 75 | return if $returnvoid; |
ac323e15 | 76 | if (wantarray) { |
6d03d463 | 77 | %{$hashref}; |
ac323e15 | 78 | } else { |
6d03d463 | 79 | $hashref; |
ac323e15 | 80 | } |
a0d0e21e LW |
81 | } |
82 | ||
83 | 1; |