Commit | Line | Data |
a0d0e21e |
1 | package Text::Abbrev; |
2 | require 5.000; |
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 |
ac323e15 |
18 | as keys key in the associative array referenced to 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: |
37 | # &abbrev(*foo,LIST); |
38 | # ... |
39 | # $long = $foo{$short}; |
40 | |
41 | sub abbrev { |
ac323e15 |
42 | my (%domain); |
43 | my ($name, $ref, $glob); |
44 | |
45 | if (ref($_[0])) { # hash reference preferably |
46 | $ref = shift; |
47 | } elsif ($_[0] =~ /^\*/) { # looks like a glob (deprecated) |
48 | $glob = shift; |
49 | } |
50 | my @cmp = @_; |
51 | |
a0d0e21e |
52 | foreach $name (@_) { |
ac323e15 |
53 | my @extra = split(//,$name); |
54 | my $abbrev = shift(@extra); |
55 | my $len = 1; |
56 | my $cmp; |
a0d0e21e |
57 | foreach $cmp (@cmp) { |
58 | next if $cmp eq $name; |
59 | while (substr($cmp,0,$len) eq $abbrev) { |
60 | $abbrev .= shift(@extra); |
61 | ++$len; |
62 | } |
63 | } |
64 | $domain{$abbrev} = $name; |
65 | while (@extra) { |
66 | $abbrev .= shift(@extra); |
67 | $domain{$abbrev} = $name; |
68 | } |
69 | } |
ac323e15 |
70 | if ($ref) { |
71 | %$ref = %domain; |
72 | return; |
73 | } elsif ($glob) { # old style |
74 | local (*hash) = $glob; |
75 | %hash = %domain; |
76 | return; |
77 | } |
78 | if (wantarray) { |
79 | %domain; |
80 | } else { |
81 | \%domain; |
82 | } |
a0d0e21e |
83 | } |
84 | |
85 | 1; |
86 | |