view release on metacpan or  search on metacpan

t/File-Locate-Iterator.t  view on Meta::CPAN

                    ['long overrun share 1',
                     'bad share length',
                     $header . "\200\000\001foo\0" ],
                    ['long overrun share 32767',
                     'bad share length',
                     $header . "\200\177\377foo\0" ],

                   ) {
    my ($name, $want_err, $str) = @$elem;

    {
      do { my $fh;
           open $fh, '>', $filename
             and print $fh $str
               and close $fh }
        or die "Cannot write file $filename: $!";
    }

    foreach my $use_mmap (0, 'if_possible') {
      my $got_err;
      my $mmap_used = ($use_mmap ? 'no, failed' : 0);
      my ($it, $got_rs);
      if (eval {
        local $SIG{'__DIE__'} = sub {
          $got_rs = $/;
          # and continue to usual die handling
        };
        $it = File::Locate::Iterator->new (database_file => $filename,
                                           use_mmap => $use_mmap);
        if (exists $it->{'mref'}) {
          $mmap_used = 'yes';
        }
        $it->next;
        1
      }) {
        $got_err = 'ok';
      } else {
        $got_err = $@;
      }
      like ($got_err, "/$want_err/",
            "$name, mmap_used=$mmap_used");
      is ($got_rs, $orig_RS,
          "$name, input record separator in __DIE__ handler");
    }
  }
}

#-----------------------------------------------------------------------------
# mmap caching

SKIP: {
  my $it1 = File::Locate::Iterator->new (database_file => $samp_locatedb,
                                         use_mmap => 'if_possible');
  my $it2 = File::Locate::Iterator->new (database_file => $samp_locatedb,
                                         use_mmap => 'if_possible');
  ($it1->_using_mmap && $it2->_using_mmap)
    or skip 'mmap "if_possible" not used', 2;

  is ($it1->{'fm'}, $it2->{'fm'}, "FileMap re-used");
  my $fm = $it1->{'fm'};
  Scalar::Util::weaken ($fm);
  undef $it1;
  undef $it2;
  is ($fm, undef, 'FileMap destroyed with iterators');
}


#------------------------------------------------------------------------------
# database_str option

{
  # example in the POD
  my $str = "\0LOCATE02\0\0/hello\0\006/world\0";
  my $it = File::Locate::Iterator->new (database_str => $str);
  $str = '';
  my $entry = $it->next;
  is ($entry, '/hello', 'database_str unaffected by later str changes');
}

#------------------------------------------------------------------------------
# database_str_ref option

{
  my $str = "\0LOCATE02\0\0/hello\0\006/world\0";
  my $it = File::Locate::Iterator->new (database_str_ref => \$str);

  { my $entry = $it->next;
    is ($entry, '/hello', 'database_str_ref');
  }
  substr($str,-2,1) = "X";

  { my $entry = $it->next;
    is ($entry, '/hello/worlX', 'database_str_ref affected by str change');
  }
}

{
  package MyTieScalarDb;
  sub TIESCALAR {
    my ($class) = @_;
    return bless {}, $class;
  }
  sub FETCH {
    Test::More::diag("MyTieScalarDb FETCH");
    return "\0LOCATE02\0\0/hello\0\006/world\0";
  }
}
{
  my $str;
  tie $str, 'MyTieScalarDb';
  my $it = File::Locate::Iterator->new (database_str_ref => \$str);

  is ($it->next, '/hello',       'database_str_ref from tied');
  is ($it->next, '/hello/world', 'database_str_ref from tied');
  is ($it->next, undef,          'database_str_ref from tied');
}
{
  my $str;
  tie $str, 'MyTieScalarDb';
  my $it = File::Locate::Iterator->new (database_str => $str);
  is ($it->next, '/hello',       'database_str from tied');