Server IP : 85.214.239.14 / Your IP : 18.226.4.248 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/perl/5.36/Text/ |
Upload File : |
package Text::Abbrev; require 5.005; # Probably works on earlier versions too. require Exporter; our $VERSION = '1.02'; =head1 NAME Text::Abbrev - 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 in the associative array referenced 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); # Usage: # abbrev \%foo, LIST; # ... # $long = $foo{$short}; sub abbrev { 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; } } } # 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;