This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Updated Search-Dict to CPAN release 1.07
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Fri, 8 Jun 2012 12:16:58 +0000 (13:16 +0100)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Sun, 17 Jun 2012 20:26:49 +0000 (21:26 +0100)
  [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
dist/Search-Dict/lib/Search/Dict.pm
dist/Search-Dict/t/Dict.t

index f957cad..55b02dc 100755 (executable)
@@ -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',
     },
 
index 5fe6f73..f34d222 100644 (file)
@@ -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 <sigh>
+  }
+}
+
 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);
index 996251e..04f8c8d 100644 (file)
@@ -1,8 +1,10 @@
 #!./perl
 
-print "1..4\n";
+use strict;
+use Test::More;
+plan tests => ( $] ge '5.008' ? 14 : 10 );
 
-$DICT = <<EOT;
+my $DICT = <<EOT;
 Aarhus
 Aaron
 Ababa
@@ -33,50 +35,89 @@ abating
 Abba
 EOT
 
+use Tie::Handle; # loads Tie::StdHandle
 use Search::Dict;
 
 open(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 = <DICT>);
-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 = <DICT>);
+    $word = <DICT>;
 
-    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 = <DICT>);
-    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 = <DICT>);
+    $word = <DICT>;
 
-    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 = <DICT>);
-    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 = <DICT>);
 
-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 = <DICT>;
+  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;
+}