88 lines
1.6 KiB
Perl
88 lines
1.6 KiB
Perl
|
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;
|
||
|
|
|