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