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