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