[win32] support win32_select(0,0,0,msec) (winsock doesn't)
[p5sagit/p5-mst-13.2.git] / lib / Text / Abbrev.pm
index 77370d3..ae6797c 100644 (file)
@@ -2,6 +2,34 @@ package Text::Abbrev;
 require 5.000;
 require Exporter;
 
+=head1 NAME
+
+abbrev - create an abbreviation table from a list
+
+=head1 SYNOPSIS
+
+    use Text::Abbrev;
+    abbrev $hashref, LIST
+
+
+=head1 DESCRIPTION
+
+Stores all unambiguous truncations of each element of LIST
+as keys key in the associative array referenced to by C<$hashref>.
+The values are the original list elements.
+
+=head1 EXAMPLE
+
+    $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
+
 @ISA = qw(Exporter);
 @EXPORT = qw(abbrev);
 
@@ -11,17 +39,26 @@ require Exporter;
 #      $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;
-       foreach $cmp (@cmp) {
+       my @extra = split(//,$name);
+       my $abbrev = shift(@extra);
+       my $len = 1;
+        my $cmp;
+       WORD: foreach $cmp (@cmp) {
            next if $cmp eq $name;
            while (substr($cmp,0,$len) eq $abbrev) {
-               $abbrev .= shift(@extra);
+                last WORD unless @extra;
+                $abbrev .= shift(@extra);
                ++$len;
            }
        }
@@ -31,6 +68,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;