Search-Dict

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

  "VERSION_FROM" => "lib/Search/Dict.pm",
  "ABSTRACT_FROM" => "lib/Search/Dict.pm",
  "AUTHOR" => "The Perl 5 Porters",
  "EXE_FILES" => [],
  "LICENSE" => "perl",
  "PREREQ_PM" => {
    "Exporter" => 0,
    "Test::More" => 0.47,
    "Tie::Handle" => 0,
  },
  INSTALLDIRS => ( $] lt '5.012' ? 'perl' : 'site' ),
);

WriteMakefile(%WriteMakefileArgs);

lib/Search/Dict.pm  view on Meta::CPAN

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.07';
our @ISA = qw(Exporter);
our @EXPORT = qw(look);

lib/Search/Dict.pm  view on Meta::CPAN

    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;
    if ( $fold ) {
      $key = $] ge $fc_available ? fc($key) : lc($key);
    }
    # find the right block
    my($min, $max) = (0, int($size / $blksize));
    my $mid;
    while ($max - $min > 1) {
	$mid = int(($max + $min) / 2);
	seek($fh, $mid * $blksize, 0)
	    or return -1;
	<$fh> if $mid;			# probably a partial line
	$_ = <$fh>;
	$_ = $xfrm->($_) if defined $xfrm;
	chomp;
	s/[^\w\s]//g if $dict;
        if ( $fold ) {
          $_ = $] ge $fc_available ? fc($_) : lc($_);
        }
	if (defined($_) && $comp->($_, $key) < 0) {
	    $min = $mid;
	}
	else {
	    $max = $mid;
	}
    }
    # find the right line
    $min *= $blksize;

lib/Search/Dict.pm  view on Meta::CPAN

	or return -1;
    <$fh> if $min;
    for (;;) {
	$min = tell($fh);
	defined($_ = <$fh>)
	    or last;
	$_ = $xfrm->($_) if defined $xfrm;
	chomp;
	s/[^\w\s]//g if $dict;
        if ( $fold ) {
          $_ = $] ge $fc_available ? fc($_) : lc($_);
        }
	last if $comp->($_, $key) >= 0;
    }
    seek($fh,$min,0);
    $min;
}

1;

t/Dict.t  view on Meta::CPAN

#!./perl

use strict;
use Test::More;
plan tests => ( $] ge '5.008' ? 14 : 10 );

my $DICT = <<EOT;
Aarhus
Aaron
Ababa
aback
abaft
abandon
abandoned
abandoning

t/Dict.t  view on Meta::CPAN

  $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";
      }

      {