Cache-BDB

 view release on metacpan or  search on metacpan

t/03-lock-env.t  view on Meta::CPAN

use Time::HiRes qw(tv_interval gettimeofday);
use Test::More skip_all => "need to deal with forking tests";
use Cache::BDB;
use strict;

my $kids = 5; # number of children to spawn
my $iterations = 1; # number of times each kid should do its thing
my $rows = 10; # number of rows each child should write, then read

my %options1 = (
	cache_root => './t/03',
	cache_file => "two.db",
	namespace => "Cache::BDB::envlock1",
	env_lock => 1,
	default_expires_in => 100,
    );	
    

t/03-lock-env.t  view on Meta::CPAN

	cache_file => "two.db",
	namespace => "Cache::BDB::envlock2",
	env_lock => 1,
	default_expires_in => 100,
    );	

    my $t0 = [gettimeofday];
    my $c1 = Cache::BDB->new(%options1);
    my $c2 = Cache::BDB->new(%options2);

    for (0 .. $iterations) {
	for (my $j = 1; $j <= $rows; $j++) {
	    my $r = $j x 4;
	    
	    my $rv1 = $c1->set($j, { $j => $r} );
	    diag("$$ faild to write $j => $r") if $rv1;
	    is($rv1, '');

	    my $rv2 = $c2->set($j, { $j => $r} );
	    diag("$$ faild to write $j => $r") if $rv2;
	    is($rv2, '');

t/03-lock.t  view on Meta::CPAN

use Time::HiRes qw(tv_interval gettimeofday);
use Test::More skip_all => "need to deal with forking tests";
use Data::Dumper;
use Cache::BDB;
use File::Path qw(rmtree);

use strict;

my $kids = 15; # number of children to spawn
my $iterations = 15; # number of times each kid should do its thing
my $rows = 120; # number of rows each child should write, then read

my %options = (
	cache_root => './t/03',
	cache_file => "one.db",
	namespace => "Cache::BDB::lock",
#	default_expires_in => 10,
);	
END {

t/03-lock.t  view on Meta::CPAN

is($r->count(), $rows);

sub run_child {
  my $t0 = [gettimeofday];
  
  my %results;
  my $c = Cache::BDB->new(%options);

  my @ids;

  for my $it (0 .. $iterations) {
    for (my $j = 1; $j <= $rows; $j++) {
      #	my $r = ($j ** $it)  x 4;
#      sleep 1 if $$ % 2 == 0;      

      my $lk = $c->{__db}->cds_lock;
#      diag("$$: locked, setting row $j");
      
      my $rv = $c->set($j, $$);
      $lk->cds_unlock();
#      diag("$$: unlocked");
      #diag("$$: set $j");
      push @ids, $j;
      
    }
  }
  

  diag("$$: getting $rows rows $iterations times");
  for(0 .. $iterations) {
    for(@ids) {
      
      my $rv = $c->get($_);
      #diag("$$: got $rv for $_") unless $$ eq $rv;
      $results{$$}->{$_} = $rv;
    }
  }
  
  my $t1 = [gettimeofday];
  diag("$$: finished in " . tv_interval($t0, $t1) .  " seconds");