LOGONLY mark 1408fb as NODOC since it appears to be a useful but minor warning cleanup

[p5sagit/p5-mst-13.2.git] / lib / Text / Abbrev.pm

diff --git a/lib/Text/Abbrev.pm b/lib/Text/Abbrev.pm
index d12dfb3..c6be63b 100644 (file)
--- a/lib/Text/Abbrev.pm
+++ b/lib/Text/Abbrev.pm
@@ -1,26 +1,34 @@
 package Text::Abbrev;
-require 5.000;
+require 5.005;         # Probably works on earlier versions too.
 require Exporter;
 
+our $VERSION = '1.01';
+
 =head1 NAME
 
 abbrev - create an abbreviation table from a list
 
 =head1 SYNOPSIS
 
-    use Abbrev;
-    abbrev *HASH, LIST
+    use Text::Abbrev;
+    abbrev $hashref, LIST
 
 
 =head1 DESCRIPTION
 
 Stores all unambiguous truncations of each element of LIST
-as keys key in the associative array indicated by C<*hash>.
+as keys in the associative array referenced by C<$hashref>.
 The values are the original list elements.
 
 =head1 EXAMPLE
 
-    abbrev(*hash,qw("list edit send abort gripe"));
+    $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
 
@@ -28,32 +36,49 @@ The values are the original list elements.
 @EXPORT = qw(abbrev);
 
 # Usage:
-#      &abbrev(*foo,LIST);
+#      abbrev \%foo, LIST;
 #      ...
 #      $long = $foo{$short};
 
 sub abbrev {
-    local(*domain) = shift;
-    @cmp = @_;
-    %domain = ();
-    foreach $name (@_) {
-       @extra = split(//,$name);
-       $abbrev = shift(@extra);
-       $len = 1;
-       foreach $cmp (@cmp) {
-           next if $cmp eq $name;
-           while (substr($cmp,0,$len) eq $abbrev) {
-               $abbrev .= shift(@extra);
-               ++$len;
+    my ($word, $hashref, $glob, %table, $returnvoid);
+
+    @_ or return;   # So we don't autovivify onto @_ and trigger warning
+    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;
            }
        }
-       $domain{$abbrev} = $name;
-       while (@extra) {
-           $abbrev .= shift(@extra);
-           $domain{$abbrev} = $name;
-       }
+    }
+    # 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;
-