Text::Abbrev (Re: More standard library test scripts)

This patch merges the Text::Abbrev related patches/tests from Gisle
and my previous patch (i.e. replaces both).

diff --git a/lib/Text/Abbrev.pm b/lib/Text/Abbrev.pm
index d12dfb3..893f3b1 100644 (file)
--- a/lib/Text/Abbrev.pm
+++ b/lib/Text/Abbrev.pm
@@ -8,19 +8,25 @@ 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 key in the associative array referenced to 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
 
@@ -33,13 +39,21 @@ The values are the original list elements.
 #      $long = $foo{$short};
 
 sub abbrev {
-    local(*domain) = shift;
-    @cmp = @_;
-    %domain = ();
+    my (%domain);
+    my ($name, $ref, $glob);
+
+    if (ref($_[0])) {           # hash reference preferably
+      $ref = shift;
+    } elsif ($_[0] =~ /^\*/) {  # looks like a glob (deprecated)
+      $glob = shift;
+    } 
+    my @cmp = @_;
+
     foreach $name (@_) {
-       @extra = split(//,$name);
-       $abbrev = shift(@extra);
-       $len = 1;
+       my @extra = split(//,$name);
+       my $abbrev = shift(@extra);
+       my $len = 1;
+        my $cmp;
        foreach $cmp (@cmp) {
            next if $cmp eq $name;
            while (substr($cmp,0,$len) eq $abbrev) {
@@ -53,6 +67,19 @@ sub abbrev {
            $domain{$abbrev} = $name;
        }
     }
+    if ($ref) {
+      %$ref = %domain;
+      return;
+    } elsif ($glob) {           # old style
+      local (*hash) = $glob;
+      %hash = %domain;
+      return;
+    }
+    if (wantarray) {
+      %domain;
+    } else {
+      \%domain;
+    }
 }
 
 1;