From 0b0a70928cebc63fc7992e87b186c34da5921ae0 Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Fri, 8 Jun 2012 13:16:58 +0100 Subject: [PATCH] Updated Search-Dict to CPAN release 1.07 [DELTA] 1.07 2012-04-11 - install into sitelib for Perl 5.12+ - use Tie::Handle to get Tie::StdHandle for older Perls - avoid using fc() in v5.15.0 - v5.15.7 - fix tests for older Perls 1.06 2012-03-31 - suppress stat() warnings on tied filehandles 1.05 2012-03-31 - no longer requires stat() on filehandle - tests use Test::More - case folds with fc() on Perl 5.15+ --- Porting/Maintainers.pl | 4 +- dist/Search-Dict/lib/Search/Dict.pm | 32 +++++++++++++--- dist/Search-Dict/t/Dict.t | 75 ++++++++++++++++++++++++++++--------- 3 files changed, 86 insertions(+), 25 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index f957cad..55b02dc 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1614,9 +1614,9 @@ use File::Glob qw(:case); 'Search::Dict' => { 'MAINTAINER' => 'p5p', - 'DISTRIBUTION' => 'FLORA/Search-Dict-1.03.tar.gz', + 'DISTRIBUTION' => 'DAGOLDEN/Search-Dict-1.07.tar.gz', 'FILES' => q[dist/Search-Dict], - 'EXCLUDED' => [qr{^t/release-.*\.t}], + 'EXCLUDED' => [qr{^t/release-.*\.t},qr{^README\..*}], 'UPSTREAM' => 'blead', }, diff --git a/dist/Search-Dict/lib/Search/Dict.pm b/dist/Search-Dict/lib/Search/Dict.pm index 5fe6f73..f34d222 100644 --- a/dist/Search-Dict/lib/Search/Dict.pm +++ b/dist/Search-Dict/lib/Search/Dict.pm @@ -2,9 +2,18 @@ package Search::Dict; require 5.000; require Exporter; +my $fc_available; +BEGIN { + $fc_available = '5.015008'; + if ( $] ge $fc_available ) { + require feature; + 'feature'->import('fc'); # string avoids warning on old Perls + } +} + use strict; -our $VERSION = '1.04'; +our $VERSION = '1.07'; our @ISA = qw(Exporter); our @EXPORT = qw(look); @@ -60,12 +69,19 @@ sub look { } $comp = sub { $_[0] cmp $_[1] } unless defined $comp; local($_); - my(@stat) = stat($fh) - or return -1; + my $fno = fileno $fh; + my @stat; + if ( defined $fno && $fno >= 0 && ! tied *{$fh} ) { # real, open file + @stat = eval { stat($fh) }; # in case fileno lies + } my($size, $blksize) = @stat[7,11]; + $size = do { seek($fh,0,2); my $s = tell($fh); seek($fh,0,0); $s } + unless defined $size; $blksize ||= 8192; $key =~ s/[^\w\s]//g if $dict; - $key = lc $key if $fold; + if ( $fold ) { + $key = $] ge $fc_available ? fc($key) : lc($key); + } # find the right block my($min, $max) = (0, int($size / $blksize)); my $mid; @@ -78,7 +94,9 @@ sub look { $_ = $xfrm->($_) if defined $xfrm; chomp; s/[^\w\s]//g if $dict; - $_ = lc $_ if $fold; + if ( $fold ) { + $_ = $] ge $fc_available ? fc($_) : lc($_); + } if (defined($_) && $comp->($_, $key) < 0) { $min = $mid; } @@ -98,7 +116,9 @@ sub look { $_ = $xfrm->($_) if defined $xfrm; chomp; s/[^\w\s]//g if $dict; - $_ = lc $_ if $fold; + if ( $fold ) { + $_ = $] ge $fc_available ? fc($_) : lc($_); + } last if $comp->($_, $key) >= 0; } seek($fh,$min,0); diff --git a/dist/Search-Dict/t/Dict.t b/dist/Search-Dict/t/Dict.t index 996251e..04f8c8d 100644 --- a/dist/Search-Dict/t/Dict.t +++ b/dist/Search-Dict/t/Dict.t @@ -1,8 +1,10 @@ #!./perl -print "1..4\n"; +use strict; +use Test::More; +plan tests => ( $] ge '5.008' ? 14 : 10 ); -$DICT = <dict-$$") or die "Can't create dict-$$: $!"; binmode DICT; # To make length expected one. print DICT $DICT; +my $word; + my $pos = look *DICT, "Ababa"; chomp($word = ); -print "not " if $pos < 0 || $word ne "Ababa"; -print "ok 1\n"; +cmp_ok $pos, ">=", 0; +is $word, "Ababa", "found 'Ababa' from file"; if (ord('a') > ord('A') ) { # ASCII $pos = look *DICT, "foo"; - chomp($word = ); + $word = ; - print "not " if $pos != length($DICT); # will search to end of file - print "ok 2\n"; + is $pos, length($DICT), "word not found will search to end of file"; my $pos = look *DICT, "abash"; chomp($word = ); - print "not " if $pos < 0 || $word ne "abash"; - print "ok 3\n"; - + cmp_ok $pos, ">=", 0; + is $word, "abash"; } else { # EBCDIC systems e.g. os390 $pos = look *DICT, "FOO"; - chomp($word = ); + $word = ; - print "not " if $pos != length($DICT); # will search to end of file - print "ok 2\n"; + is $pos, length($DICT); # will search to end of file my $pos = look *DICT, "Abba"; chomp($word = ); - print "not " if $pos < 0 || $word ne "Abba"; - print "ok 3\n"; + cmp_ok $pos, ">=", 0; + is $word, "Abba"; } $pos = look *DICT, "aarhus", 1, 1; chomp($word = ); -print "not " if $pos < 0 || $word ne "Aarhus"; -print "ok 4\n"; +cmp_ok $pos, ">=", 0; +is $word, "Aarhus"; close DICT or die "cannot close"; + +{ + local $^W = 1; # turn on global warnings for stat() in Search::Dict + + my $warn = ''; + local $SIG{__WARN__} = sub { $warn = join("\n",@_) }; + + tie *DICT, 'Tie::StdHandle', "<", "dict-$$"; + + $pos = look \*DICT, "aarhus", 1, 1; + is( $warn, '', "no warning seen" ); + + $word = ; + chomp $word; + + cmp_ok $pos, ">=", 0, "case-insensitive search for 'aarhus' returned > 0"; + is $word, "Aarhus", "case-insensitive search found 'Aarhus'"; + +} unlink "dict-$$"; + +if ( $] ge '5.008' ) { + open my $strfh, "<", \$DICT or die $!; + + { + my $pos = look $strfh, 'Ababa'; + chomp($word = <$strfh>); + cmp_ok $pos, ">=", 0; + is $word, "Ababa"; + } + + { + my $pos = look $strfh, "aarhus", 1, 1; + chomp($word = <$strfh>); + cmp_ok $pos, ">=", 0; + is $word, "Aarhus"; + } + + close $strfh; +} -- 1.8.3.1