1*0Sstevel@tonic-gatepackage Text::Abbrev; 2*0Sstevel@tonic-gaterequire 5.005; # Probably works on earlier versions too. 3*0Sstevel@tonic-gaterequire Exporter; 4*0Sstevel@tonic-gate 5*0Sstevel@tonic-gateour $VERSION = '1.01'; 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gate=head1 NAME 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gateabbrev - create an abbreviation table from a list 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gate=head1 SYNOPSIS 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gate use Text::Abbrev; 14*0Sstevel@tonic-gate abbrev $hashref, LIST 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gate 17*0Sstevel@tonic-gate=head1 DESCRIPTION 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gateStores all unambiguous truncations of each element of LIST 20*0Sstevel@tonic-gateas keys in the associative array referenced by C<$hashref>. 21*0Sstevel@tonic-gateThe values are the original list elements. 22*0Sstevel@tonic-gate 23*0Sstevel@tonic-gate=head1 EXAMPLE 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gate $hashref = abbrev qw(list edit send abort gripe); 26*0Sstevel@tonic-gate 27*0Sstevel@tonic-gate %hash = abbrev qw(list edit send abort gripe); 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gate abbrev $hashref, qw(list edit send abort gripe); 30*0Sstevel@tonic-gate 31*0Sstevel@tonic-gate abbrev(*hash, qw(list edit send abort gripe)); 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gate=cut 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gate@ISA = qw(Exporter); 36*0Sstevel@tonic-gate@EXPORT = qw(abbrev); 37*0Sstevel@tonic-gate 38*0Sstevel@tonic-gate# Usage: 39*0Sstevel@tonic-gate# abbrev \%foo, LIST; 40*0Sstevel@tonic-gate# ... 41*0Sstevel@tonic-gate# $long = $foo{$short}; 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gatesub abbrev { 44*0Sstevel@tonic-gate my ($word, $hashref, $glob, %table, $returnvoid); 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gate @_ or return; # So we don't autovivify onto @_ and trigger warning 47*0Sstevel@tonic-gate if (ref($_[0])) { # hash reference preferably 48*0Sstevel@tonic-gate $hashref = shift; 49*0Sstevel@tonic-gate $returnvoid = 1; 50*0Sstevel@tonic-gate } elsif (ref \$_[0] eq 'GLOB') { # is actually a glob (deprecated) 51*0Sstevel@tonic-gate $hashref = \%{shift()}; 52*0Sstevel@tonic-gate $returnvoid = 1; 53*0Sstevel@tonic-gate } 54*0Sstevel@tonic-gate %{$hashref} = (); 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate WORD: foreach $word (@_) { 57*0Sstevel@tonic-gate for (my $len = (length $word) - 1; $len > 0; --$len) { 58*0Sstevel@tonic-gate my $abbrev = substr($word,0,$len); 59*0Sstevel@tonic-gate my $seen = ++$table{$abbrev}; 60*0Sstevel@tonic-gate if ($seen == 1) { # We're the first word so far to have 61*0Sstevel@tonic-gate # this abbreviation. 62*0Sstevel@tonic-gate $hashref->{$abbrev} = $word; 63*0Sstevel@tonic-gate } elsif ($seen == 2) { # We're the second word to have this 64*0Sstevel@tonic-gate # abbreviation, so we can't use it. 65*0Sstevel@tonic-gate delete $hashref->{$abbrev}; 66*0Sstevel@tonic-gate } else { # We're the third word to have this 67*0Sstevel@tonic-gate # abbreviation, so skip to the next word. 68*0Sstevel@tonic-gate next WORD; 69*0Sstevel@tonic-gate } 70*0Sstevel@tonic-gate } 71*0Sstevel@tonic-gate } 72*0Sstevel@tonic-gate # Non-abbreviations always get entered, even if they aren't unique 73*0Sstevel@tonic-gate foreach $word (@_) { 74*0Sstevel@tonic-gate $hashref->{$word} = $word; 75*0Sstevel@tonic-gate } 76*0Sstevel@tonic-gate return if $returnvoid; 77*0Sstevel@tonic-gate if (wantarray) { 78*0Sstevel@tonic-gate %{$hashref}; 79*0Sstevel@tonic-gate } else { 80*0Sstevel@tonic-gate $hashref; 81*0Sstevel@tonic-gate } 82*0Sstevel@tonic-gate} 83*0Sstevel@tonic-gate 84*0Sstevel@tonic-gate1; 85