mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-27 08:27:54 +00:00
84 lines
1.9 KiB
Perl
84 lines
1.9 KiB
Perl
|
package Text::Abbrev;
|
||
|
|
require 5.005; # Probably works on earlier versions too.
|
||
|
|
require Exporter;
|
||
|
|
|
||
|
|
our $VERSION = '1.00';
|
||
|
|
|
||
|
|
=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 in the associative array referenced 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 ($word, $hashref, $glob, %table, $returnvoid);
|
||
|
|
|
||
|
|
if (ref($_[0])) { # hash reference preferably
|
||
|
|
$hashref = shift;
|
||
|
|
$returnvoid = 1;
|
||
|
|
} elsif (ref \$_[0] eq 'GLOB') { # is actually a glob (deprecated)
|
||
|
|
$hashref = \%{shift()};
|
||
|
|
$returnvoid = 1;
|
||
|
|
}
|
||
|
|
%{$hashref} = ();
|
||
|
|
|
||
|
|
WORD: foreach $word (@_) {
|
||
|
|
for (my $len = (length $word) - 1; $len > 0; --$len) {
|
||
|
|
my $abbrev = substr($word,0,$len);
|
||
|
|
my $seen = ++$table{$abbrev};
|
||
|
|
if ($seen == 1) { # We're the first word so far to have
|
||
|
|
# this abbreviation.
|
||
|
|
$hashref->{$abbrev} = $word;
|
||
|
|
} elsif ($seen == 2) { # We're the second word to have this
|
||
|
|
# abbreviation, so we can't use it.
|
||
|
|
delete $hashref->{$abbrev};
|
||
|
|
} else { # We're the third word to have this
|
||
|
|
# abbreviation, so skip to the next word.
|
||
|
|
next WORD;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# Non-abbreviations always get entered, even if they aren't unique
|
||
|
|
foreach $word (@_) {
|
||
|
|
$hashref->{$word} = $word;
|
||
|
|
}
|
||
|
|
return if $returnvoid;
|
||
|
|
if (wantarray) {
|
||
|
|
%{$hashref};
|
||
|
|
} else {
|
||
|
|
$hashref;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|