The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
########################################
# this series tests deletion of objects and Oids while cursor active
# this script does the main test
# these tests vary 3 params
# 1) the items being deleted can start as objects or Oids
# 2) the active cursor can be 'open' or 'running' 
#    open means 'find' executed but no get or get_next
#    running means 'find' and 1 or more 'get_next', but cursor not exhausted
# 3) post-del, the cursor can be accessed via 'get' (ie, get all) or 'get_next'
########################################
use t::lib;
use strict;
use Carp;
use Test::More;
use Test::Deep;
use delUtil;

use Class::AutoDB;
use delUtil; use FindDel;

my($num_objects)=@ARGV;
defined $num_objects or $num_objects=5;

# create AutoDB database & SDBM files
my $autodb=new Class::AutoDB(database=>testdb); 
isa_ok($autodb,'Class::AutoDB','class is Class::AutoDB - sanity check');

# get the top object - holds all the test objects
my($top)=$autodb->get(collection=>'FindDel',testcase=>'top');
report_fail
  (defined $top,'top object exists - probably have to rerun put script',__FILE__,__LINE__);
my $case2objects=$top->case2objects;

# vary params and do tests
for my $param1 (qw(obj oid)) {
  for my $param2 (qw(open running)) {
    for my $param3 (qw(get getnext)) {
      my $case=join('_',$param1,$param2,$param3);
      my $objects=$case2objects->{$case};
      my(@objects,$entry_type);
      # process param1: get objects or use Oids
      if ($param1 eq 'obj') {	# items start as objects, so get 'em
	@objects=$autodb->get(collection=>'FindDel',testcase=>$case);
	$entry_type='object';
      } else {			# items already Oids
	@objects=@{$case2objects->{$case}};
	$entry_type='Oid';
      }
      report_fail
	(scalar @objects==$num_objects,
	 "objects for case $case exist - probably have to rerun put script",__FILE__,__LINE__);
      my $ok=1;
      for my $object (@objects) {
	$ok&&=ok_objcache($object,$entry_type,'FindDel_case',
			  "at start: objects for case $case in object cache as $entry_type",
			  __FILE__,__LINE__,'no_report_pass');
	last unless $ok;
      }
      # process param2: do 'find' and possibly 'get_next'
      my $cursor=$autodb->find(collection=>'FindDel',testcase=>$case);
      if ($param2 eq 'running') {
	my $object=$cursor->get_next;
      }
      # del some objects/Oids
      my @evens=grep {!($_%2)} (0..$num_objects-1);
      my @odds=grep {($_%2)} (0..$num_objects-1);
      $autodb->del(@objects[@evens]);
      # process param3: get objects all-at-once or in a get_next loop
      my(@actual,@correct);
      if ($param3 eq 'get') {
	@actual=$cursor->get;
      } else {
	while (defined(my $object=$cursor->get_next)) {
	  push(@actual,$object);
	}
      }
      # now, how did we do?
      my $actual_count=scalar @actual;
      my $correct_count=$num_objects-scalar @evens;
      $ok=1;
      $ok&&=report_fail
	($actual_count==$correct_count,
	 "$case: number of object. Expected $correct_count. Got $actual_count",
	 __FILE__,__LINE__);
      if ($ok) {
	@actual=sort {$a->name cmp $b->name} @actual;
	@correct=sort {$a->name cmp $b->name} @objects[@odds];
	my($ok,$details)=cmp_details(\@actual,bag(@correct));
	report($ok,"$case: correct objects",__FILE__,__LINE__,$details);
      }
      $ok=1;
      for my $i (@evens) {
	my $object=$objects[$i];
	$ok&&=ok_objcache($object,'OidDeleted','FindDel_case',
			  'get mangled deleted object in cache',__FILE__,__LINE__,
			  'no_report_pass');
	last unless $ok;
      }
      for my $i (@odds) {
	my $object=$objects[$i]; 
	$ok&&=ok_objcache($object,'object','FindDel_case',
			  'get mangled non-deleted object in cache',
			  __FILE__,__LINE__,'no_report_pass');
	last unless $ok;
      }
      report_pass($ok,"$case: correct object cache after del & get");
    }}}

done_testing();