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 DBI;
use Fcntl;   # For O_RDWR, O_CREAT, etc.
use SDBM_File;
use Class::AutoDB::Serialize;
use testSerialize01;

# The testSerialize series tests Class::AutoDB::Serialize
# This test stores a series of simple objects for later 
# fetch by its companion testSerialize1b.simple.t

SKIP: {
  # make sure databases exist
  my $dbh=DBI->connect('dbi:mysql:database=test');
  skip "! Cannot connect to database: ".$dbh->errstr."\n".
    "These tests require a MySQL database named 'test'.  The user running the test must have permission to create and drop tables, and select and update data."
      if $dbh->err;
  my %oid;
  my $tie=tie(%oid, 'SDBM_File', 'testSerialize.sdbm', O_RDWR, 0666);
  skip "! Cannot open SDBM file 'testSerialize.sdbm': ".$!."\n".
    "These tests require an SDBM file named 'testSerialize.sdbm'.  The user running the test must have permission to read and write this file."
      unless $tie;

  Class::AutoDB::Serialize->dbh($dbh);

  sub store {
    my($key,$obj,$transients)=@_;
    $oid{$key}=$obj->oid;
    $obj->store($transients);
    ok(1,$key);
  }

  # Simple black box testing of the interface
  my $obj=new testSerialize(integer=>1234);
  my $oid=$obj->oid;
  my $db_obj;
  # dbh
  Class::AutoDB::Serialize->dbh($dbh); # this had to work to get this far, but do it anyway...
  ok($dbh==Class::AutoDB::Serialize->dbh,'dbh');

  # store / fetch (various flavors)
  $obj->store;
  ok(1,'store');
  $db_obj=$obj->fetch($oid);
  is_deeply($obj,$db_obj,'fetch as object method');
  $db_obj=Class::AutoDB::Serialize->fetch($oid);
  is_deeply($obj,$db_obj,'fetch as class method');
  $db_obj=Class::AutoDB::Serialize::fetch($oid);
  is_deeply($obj,$db_obj,'fetch as function');

  ####################
  # The next test fetches a non-existant object which generates an error
  $db_obj=undef;
  eval {$db_obj=$obj->fetch(0)}; # hopefully no object has oid 0
  ok(!$db_obj && $@,'fetch of nonexistant object');
  ####################

  # get obj2oid,oid (various flavors)
  is($oid,$obj->obj2oid,'obj2oid as object method (get)');
  is($oid,Class::AutoDB::Serialize->obj2oid($obj),'obj2oid as class method (get)');
  is($oid,Class::AutoDB::Serialize::obj2oid($obj),'obj2oid as function (get)');

  is($oid,$obj->oid,'oid as object method (get)');
  is($oid,Class::AutoDB::Serialize->oid($obj),'oid as class method (get)');
  is($oid,Class::AutoDB::Serialize::oid($obj),'oid as function (get)');

  # get oid2obj (various flavors)
  is_deeply($obj,$obj->oid2obj($oid),'oid2obj as object method (get)');
  is_deeply($obj,Class::AutoDB::Serialize->oid2obj($oid),'oid2obj as class method (get)');
  is_deeply($obj,Class::AutoDB::Serialize::oid2obj($oid),'oid2obj as function (get)');

  # set obj2oid,oid (various flavors)
  $oid=1234;
  is($oid,$obj->obj2oid($oid),'obj2oid as object method (set)');
  is($oid,Class::AutoDB::Serialize->obj2oid($obj,$oid),'obj2oid as class method (set)');
  is($oid,Class::AutoDB::Serialize::obj2oid($obj,$oid),'obj2oid as function (set)');

  is($oid,$obj->oid($oid),'oid as object method (set)');
  is($oid,Class::AutoDB::Serialize->oid($obj,$oid),'oid as class method (set)');
  is($oid,Class::AutoDB::Serialize::oid($obj,$oid),'oid as function (set)');

  # set oid2obj (various flavors)
  is_deeply($obj,$obj->oid2obj($oid,$obj),'oid2obj as object method (get)');
  is_deeply($obj,Class::AutoDB::Serialize->oid2obj($oid,$obj),'oid2obj as class method (get)');
  is_deeply($obj,Class::AutoDB::Serialize::oid2obj($oid,$obj),'oid2obj as function (get)');

  # Test store of simple objects. Companion test does fetches
  my $obj=new testSerialize;	# empty object
  store('empty',$obj);

  my $obj=new testSerialize(integer=>1234);
  store('integer',$obj);

  my $obj=new testSerialize(float=>12.34);
  store('float',$obj);

  my $obj=new testSerialize(string=>'a string');
  store('string',$obj);

  my $obj=new testSerialize(list=>[qw(a b c d)]);
  store('list',$obj);;

  my $obj=new testSerialize(hash=>{a=>1,b=>2,c=>3,d=>4});
  store('hash',$obj);

  my $obj=new testSerialize(integer=>1234,
			     float=>12.34,
			     string=>'a string',
			     list=>[qw(a b c d)],
			     hash=>{a=>1,b=>2,c=>3,d=>4});
  store('simple_multi',$obj);
  
  # Test boundary cases for store of simple objects. Companion test does fetches
  my $obj=new testSerialize(integer=>0);
  store('integer_0',$obj);

  my $obj=new testSerialize(float=>0);
  store('float_0',$obj);

  my $obj=new testSerialize(string=>'');
  store('string_empty',$obj);

  my $obj=new testSerialize(list=>[]);
  store('list_0',$obj);;
  my $obj=new testSerialize(list=>[qw(a)]);
  store('list_1',$obj);;
  my $obj=new testSerialize(list=>[qw(a b)]);
  store('list_2',$obj);;
  my $obj=new testSerialize(list=>[qw(a b c)]);
  store('list_3',$obj);;

  my $obj=new testSerialize(hash=>{});
  store('hash_0',$obj);
  my $obj=new testSerialize(hash=>{a=>1});
  store('hash_1',$obj);
  my $obj=new testSerialize(hash=>{a=>1,b=>2});
  store('hash_2',$obj);
  my $obj=new testSerialize(hash=>{a=>1,b=>2,c=>3});
  store('hash_3',$obj);

  my $obj=new testSerialize(list=>[[]]);
  store('list_list_1',$obj);;
  my $obj=new testSerialize(list=>[[],[]]);
  store('list_list_2',$obj);;
  my $obj=new testSerialize(list=>[[],[],[]]);
  store('list_list_3',$obj);;

  my $obj=new testSerialize(hash=>{a=>{}});
  store('hash_hash_1',$obj);
  my $obj=new testSerialize(hash=>{a=>{},b=>{}});
  store('hash_hash_2',$obj);
  my $obj=new testSerialize(hash=>{a=>{},b=>{},c=>{}});
  store('hash_hash_3',$obj);

  # Test transient attribues.  Companion test does fetches
  my $obj=new testSerialize(integer=>1234,
			    tran1=>'this string should not be stored');
  store('transients_1',$obj,['tran1']);
  my $obj=new testSerialize(integer=>1234,
			    tran1=>'this string should not be stored',
			    tran2=>'this string should not be stored');
  store('transients_2',$obj,['tran1','tran2']);
  

  untie %oid;
}
1;

done_testing();