diff options
Diffstat (limited to 'contrib/perl5/lib/Text')
| -rw-r--r-- | contrib/perl5/lib/Text/Abbrev.pm | 68 | ||||
| -rw-r--r-- | contrib/perl5/lib/Text/ParseWords.pm | 4 | ||||
| -rw-r--r-- | contrib/perl5/lib/Text/Soundex.pm | 2 | ||||
| -rw-r--r-- | contrib/perl5/lib/Text/Tabs.pm | 14 |
4 files changed, 42 insertions, 46 deletions
diff --git a/contrib/perl5/lib/Text/Abbrev.pm b/contrib/perl5/lib/Text/Abbrev.pm index ae6797c..d4f12d0 100644 --- a/contrib/perl5/lib/Text/Abbrev.pm +++ b/contrib/perl5/lib/Text/Abbrev.pm @@ -1,5 +1,5 @@ package Text::Abbrev; -require 5.000; +require 5.005; # Probably works on earlier versions too. require Exporter; =head1 NAME @@ -15,7 +15,7 @@ abbrev - create an abbreviation table from a list =head1 DESCRIPTION Stores all unambiguous truncations of each element of LIST -as keys key in the associative array referenced to by C<$hashref>. +as keys in the associative array referenced by C<$hashref>. The values are the original list elements. =head1 EXAMPLE @@ -34,54 +34,48 @@ The values are the original list elements. @EXPORT = qw(abbrev); # Usage: -# &abbrev(*foo,LIST); +# abbrev \%foo, LIST; # ... # $long = $foo{$short}; sub abbrev { - my (%domain); - my ($name, $ref, $glob); + my ($word, $hashref, $glob, %table, $returnvoid); if (ref($_[0])) { # hash reference preferably - $ref = shift; - } elsif ($_[0] =~ /^\*/) { # looks like a glob (deprecated) - $glob = shift; - } - my @cmp = @_; - - foreach $name (@_) { - 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) { - last WORD unless @extra; - $abbrev .= shift(@extra); - ++$len; + $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; - } } - if ($ref) { - %$ref = %domain; - return; - } elsif ($glob) { # old style - local (*hash) = $glob; - %hash = %domain; - return; + # Non-abbreviations always get entered, even if they aren't unique + foreach $word (@_) { + $hashref->{$word} = $word; } + return if $returnvoid; if (wantarray) { - %domain; + %{$hashref}; } else { - \%domain; + $hashref; } } 1; - diff --git a/contrib/perl5/lib/Text/ParseWords.pm b/contrib/perl5/lib/Text/ParseWords.pm index 065c2f7..2a6afc3 100644 --- a/contrib/perl5/lib/Text/ParseWords.pm +++ b/contrib/perl5/lib/Text/ParseWords.pm @@ -1,7 +1,7 @@ package Text::ParseWords; use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE); -$VERSION = "3.1"; +$VERSION = "3.2"; require 5.000; @@ -49,7 +49,7 @@ sub nested_quotewords { sub parse_line { # We will be testing undef strings - local($^W) = 0; + no warnings; my($delimiter, $keep, $line) = @_; my($quote, $quoted, $unquoted, $delim, $word, @pieces); diff --git a/contrib/perl5/lib/Text/Soundex.pm b/contrib/perl5/lib/Text/Soundex.pm index ddc758c..3079b90 100644 --- a/contrib/perl5/lib/Text/Soundex.pm +++ b/contrib/perl5/lib/Text/Soundex.pm @@ -5,6 +5,8 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(&soundex $soundex_nocode); +$VERSION = '1.0'; + # $Id: soundex.pl,v 1.2 1994/03/24 00:30:27 mike Exp $ # # Implementation of soundex algorithm as described by Knuth in volume diff --git a/contrib/perl5/lib/Text/Tabs.pm b/contrib/perl5/lib/Text/Tabs.pm index acd7afb..933f917 100644 --- a/contrib/perl5/lib/Text/Tabs.pm +++ b/contrib/perl5/lib/Text/Tabs.pm @@ -7,7 +7,7 @@ require Exporter; @EXPORT = qw(expand unexpand $tabstop); use vars qw($VERSION $tabstop $debug); -$VERSION = 96.121201; +$VERSION = 98.112801; use strict; @@ -18,7 +18,7 @@ BEGIN { sub expand { - my @l = @_; + my (@l) = @_; for $_ (@l) { 1 while s/(^|\n)([^\t\n]*)(\t+)/ $1. $2 . (" " x @@ -32,7 +32,7 @@ sub expand sub unexpand { - my @l = @_; + my (@l) = @_; my @e; my $x; my $line; @@ -73,11 +73,11 @@ Text::Tabs -- expand and unexpand tabs per the unix expand(1) and unexpand(1) =head1 SYNOPSIS -use Text::Tabs; + use Text::Tabs; -$tabstop = 4; -@lines_without_tabs = expand(@lines_with_tabs); -@lines_with_tabs = unexpand(@lines_without_tabs); + $tabstop = 4; + @lines_without_tabs = expand(@lines_with_tabs); + @lines_with_tabs = unexpand(@lines_without_tabs); =head1 DESCRIPTION |
