The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use t::lib;
use strict;
use Test::More;
use Test::Deep;
use Class::AutoClass::Args;
use Class::AutoDB::Registry;
use Class::AutoDB::Collection;
use Class::AutoDB::Registration;
use testRegistry01;

# Test Class::AutoDB::Registry
# Simple black box testing of the interface

sub test {
  my($testname,$registers,$collections)=@_;
  my $registry=new Class::AutoDB::Registry;
  for my $reg (@$registers) {
    my @args=@$reg;
    push(@args,(-class=>'testRegistryTop')); # to test class2collections
    $registry->register(@args);
  }
  # Compute the number and names of collections that should have been registered
  my %collections;
  if ($collections) {		# compute from $collections param
    for my $reg (@$collections) {
      my $args=new Class::AutoClass::Args($reg);
      my $registration=new Class::AutoDB::Registration($args);
      my $collection=new Class::AutoDB::Collection(-name=>$args->collection,
						   -register=>$registration->keys);
      $collections{$collection->name}=$collection;
    }
  } else {			# compute from registrations
    for my $reg (@$registers) {
      my @args=@$reg;
      my $registration=new Class::AutoDB::Registration(@args);
      my $names=$registration->collnames;
      for my $name (@$names) {
	$collections{$name}=$name;
      }}}
  my @names=keys %collections;

  # Test collections method
  my @t_collections=$registry->collections;
  my $t_collections=$registry->collections;
  my @t_names=map {$_->name} @t_collections;
  is_deeply(\@t_names,\@names,"$testname: collections as ARRAY: count");
  my @t_names=map {$_->name} @$t_collections;
  is_deeply(\@t_names,\@names,"$testname: collections as ARRAY ref: count");

  # Test collection method
  my @t_names=map {$registry->collection($_)->name} keys %collections;
  is_deeply(\@t_names,\@names,"$testname: collection: names");
  if ($collections) {
    is_deeply(\@t_collections,[values %collections],"$testname: collections as ARRAY: objects");
    is_deeply($t_collections,[values %collections],"$testname: collections as ARRAY ref: objects");
    # Test collection method
    my %t_collections;
    @t_collections{keys %collections}=map {$registry->collection($_)} keys %collections;
    is_deeply(\%t_collections,\%collections,"$testname: collection: objects");
  }
  # Test class2collections method (assumes all registrations are on testRegistryTop
  my $class='testRegistryTop';
  my $class_colls=$registry->class2collections('testRegistryTop') || [];
  my @t_names=map {$_->name} @$class_colls;
  cmp_bag(\@t_names,\@names,"$testname: class2collections: names");
  if ($collections) {
    cmp_bag($class_colls,[values %collections],"$testname: class2collections: objects");
  }

  $registry;
}
  
# Tests start here
#goto skip;

my $registry=new Class::AutoDB::Registry;
is(ref $registry,'Class::AutoDB::Registry','empty collection: new');
is($registry->autodb,undef,'empty collection: default autodb');
is($registry->oid,1,'empty collection: default oid');

# Test boundary cases for registrations
my $registry=test
  ('register 0 registrations',
   [],
   [],
  );
my $registry=test
  ('register 1 registration - single collection',
   [[-collection=>'Collection',-keys=>q(skey1 string)],
   ],
   [[-collection=>'Collection',-keys=>q(skey1 string)],
   ],
  );
my $registry=test
  ('register 2 registrations - single collection',
   [[-collection=>'Collection',-keys=>q(skey1 string)],
    [-collection=>'Collection',-keys=>q(skey2 string)],
   ],
   [[-collection=>'Collection',-keys=>q(skey1 string, skey2 string)],
   ],
  );
my $registry=test
  ('register 3 registrations - single collection',
   [[-collection=>'Collection',-keys=>q(skey1 string)],
    [-collection=>'Collection',-keys=>q(skey2 string)],
    [-collection=>'Collection',-keys=>q(skey3 string)],
   ],
   [[-collection=>'Collection',-keys=>q(skey1 string, skey2 string, skey3 string)],
   ],
  );
my $registry=test
  ('register 4 registrations - single collection',
   [[-collection=>'Collection',-keys=>q(skey1 string)],
    [-collection=>'Collection',-keys=>q(skey2 string)],
    [-collection=>'Collection',-keys=>q(skey3 string)],
    [-collection=>'Collection',-keys=>q(skey4 string)],
   ],
   [[-collection=>'Collection',-keys=>q(skey1 string, skey2 string, skey3 string, skey4 string)],
   ],
  );
my $registry=test
  ('register 1 registration - different collections',
   [[-collection=>'Collection1',-keys=>q(skey1 string)],
   ],
   [[-collection=>'Collection1',-keys=>q(skey1 string)],
   ],
  );
my $registry=test
  ('register 2 registrations - different collections',
   [[-collection=>'Collection1',-keys=>q(skey1 string)],
    [-collection=>'Collection2',-keys=>q(skey2 string)],
   ],
   [[-collection=>'Collection1',-keys=>q(skey1 string)],
    [-collection=>'Collection2',-keys=>q(skey2 string)],
   ],
  );
my $registry=test
  ('register 3 registrations - different collections',
   [[-collection=>'Collection1',-keys=>q(skey1 string)],
    [-collection=>'Collection2',-keys=>q(skey2 string)],
    [-collection=>'Collection3',-keys=>q(skey3 string)],
   ],
   [[-collection=>'Collection1',-keys=>q(skey1 string)],
    [-collection=>'Collection2',-keys=>q(skey2 string)],
    [-collection=>'Collection3',-keys=>q(skey3 string)],
   ],
  );
my $registry=test
  ('register 4 registrations - different collections',
   [[-collection=>'Collection1',-keys=>q(skey1 string)],
    [-collection=>'Collection2',-keys=>q(skey2 string)],
    [-collection=>'Collection3',-keys=>q(skey3 string)],
    [-collection=>'Collection4',-keys=>q(skey4 string)],
   ],
   [[-collection=>'Collection1',-keys=>q(skey1 string)],
    [-collection=>'Collection2',-keys=>q(skey2 string)],
    [-collection=>'Collection3',-keys=>q(skey3 string)],
    [-collection=>'Collection4',-keys=>q(skey4 string)],
   ],
  );

my $registry=test
  ('register 4 registrations - different keys and collections',
   [[-collection=>'Collection1',-keys=>q(skey1 string)],
    [-collection=>'Collection1',-keys=>q(skey2 string)],
    [-collection=>'Collection2',-keys=>q(skey3 string)],
    [-collection=>'Collection2',-keys=>q(skey4 string)],
   ],
   [[-collection=>'Collection1',-keys=>q(skey1 string, skey2 string)],
    [-collection=>'Collection2',-keys=>q(skey3 string, skey4 string)],
   ],
  );

# Test inheritance of registrations
sub test_inheritance {
  my($registry,$register,$top,$left,$right,$bottom,$testname)=@_;
  $registry->register($register);
  test_inheritance1($registry,'testRegistryTop',$top,"$testname: top");
  test_inheritance1($registry,'testRegistryLeft',$left,"$testname: left");
  test_inheritance1($registry,'testRegistryRight',$right,"$testname: right");
  test_inheritance1($registry,'testRegistryBottom',$bottom,"$testname: bottom");
}
sub test_inheritance1 {
  my($registry,$class,$names,$testname)=@_;
  $names or $names=[];
  my $t_collections=$registry->class2collections($class) || [];
  my @t_names=map {$_->name} @$t_collections;
  cmp_bag(\@t_names,$names,$testname);
}

my $registry=new Class::AutoDB::Registry;
test_inheritance($registry,{-class=>'testRegistryTop',-collection=>'CollectionTop'},
		 ['CollectionTop'],
		 undef,undef,undef,
		 'inheritance: register Top',
		 );
test_inheritance($registry,{-class=>'testRegistryLeft',-collection=>'CollectionLeft'},
		 ['CollectionTop'],
		 ['CollectionTop','CollectionLeft'],
		 undef,undef,
		 'inheritance: register Top, Left',
		 );
test_inheritance($registry,{-class=>'testRegistryRight',-collection=>'CollectionRight'},
		 ['CollectionTop'],
		 ['CollectionTop','CollectionLeft'],
		 ['CollectionTop','CollectionRight'],
		 undef,
		 'inheritance: register Top, Left, Right',
		 );
test_inheritance($registry,{-class=>'testRegistryBottom',-collection=>'CollectionBottom'},
		 ['CollectionTop'],
		 ['CollectionTop','CollectionLeft'],
		 ['CollectionTop','CollectionRight'],
		 ['CollectionTop','CollectionLeft','CollectionRight','CollectionBottom'],
		 'inheritance: register Top, Left, Right, Bottom',
		);

# Do it again with multiple collections
my $registry=new Class::AutoDB::Registry;
test_inheritance($registry,
		 {-class=>'testRegistryTop',-collections=>['CollectionTop1','CollectionTop2']},
		 ['CollectionTop1','CollectionTop2'],
		 undef,undef,undef,
		 'inheritance: register 2 Top',
		 );
test_inheritance($registry,
		 {-class=>'testRegistryLeft',-collections=>['CollectionLeft1','CollectionLeft2']},
		 ['CollectionTop1','CollectionTop2'],
		 ['CollectionTop1','CollectionTop2','CollectionLeft1','CollectionLeft2'],
		 undef,undef,
		 'inheritance: register 2 Top, Left',
		 );
test_inheritance($registry,
		 {-class=>'testRegistryRight',
		  -collections=>['CollectionRight1','CollectionRight2']},
		 ['CollectionTop1','CollectionTop2'],
		 ['CollectionTop1','CollectionTop2','CollectionLeft1','CollectionLeft2'],
		 ['CollectionTop1','CollectionTop2','CollectionRight1','CollectionRight2'],
		 undef,
		 'inheritance: register 2 Top, Left, Right',
		 );
test_inheritance($registry,
		 {-class=>'testRegistryBottom',
		  -collections=>['CollectionBottom1','CollectionBottom2']},
		 ['CollectionTop1','CollectionTop2'],
		 ['CollectionTop1','CollectionTop2','CollectionLeft1','CollectionLeft2'],
		 ['CollectionTop1','CollectionTop2','CollectionRight1','CollectionRight2'],
		 ['CollectionTop1','CollectionTop2',
		  'CollectionLeft1','CollectionLeft2',
		  'CollectionRight1','CollectionRight2',
		  'CollectionBottom1','CollectionBottom2'],
		 'inheritance: register 2 Top, Left, Right, Bottom',
		 );

done_testing();