The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

BEGIN {
	use lib qw( t );
}

use strict;
use Test::More tests => 11;

use my_dbi_conf;
use test_config;
test_config->recreate_tables;

package MyObject;

use strict;
use vars qw (@ISA $CONF $TABLE_DEF);
BEGIN {
    @ISA    = qw/MyBaseObject/;
    $CONF   = {
        MyObject_Alias => {
            class => __PACKAGE__,
            base_table      =>  'T_MyObject',
            isa             =>  \@ISA,
            field           =>  [ qw/id color val/ ],
            id_field        =>  'id',
            skip_undef      =>  [ qw/color val/ ],
            as_string_order =>  [ qw/id class color val/ ],
            no_security     =>  1,
        },
    };
    $TABLE_DEF = <<SQL;
CREATE TABLE IF NOT EXISTS T_MyObject (
    id  int(11) PRIMARY KEY,
    color char(10),
    val   tinyint,
    UNIQUE key color (color, val)
)
SQL
}
 
__PACKAGE__->config_and_init;

package main;

my ($h, $s);

##-----  initial save with single inheritance  -----
my $t = 'save obj (insert) w/single inheritance';
ok( $h = Helicopter->new( {	name			=> 'Whirly Bird',
							owner			=> 25,
							ceiling			=> 7500,
							lift_capacity	=> 800
						} ), $t . ', create obj' );
ok( my $hid = $h->save->id, $t . ', id defined after save');

## check that we can get back the same thing
ok( $h->compare(Helicopter->fetch($h->id)), $t . ', fetch & compare' );

##-----  initial save with multiple inheritance  -----
$t = 'save obj (insert) w/multiple inheritance';
ok( $s = Seaplane->new( {	name			=> 'PuddleJumper',
							owner			=> 20,
							ceiling			=> 9000,
							wingspan		=> 36,
							min_depth		=> 2.5,
							anchor			=> Anchor->new({weight => 25}),
							max_wave_height	=> 2
						} ), $t . ', create obj' );

ok( my $sid = $s->save->id, $t . ', id defined after save' );

## check that we can get back the same thing
ok( $s->compare(Seaplane->fetch($s->id)), $t . ', fetch & compare' );

##-----  update save with single inheritance  -----
$t = 'save obj (update) w/single inheritance';
$h->{ceiling} = 10000;
$h->save;
ok( $h->compare(Helicopter->fetch($h->id)), $t );

##-----  update save with multiple inheritance  -----
$t = 'save obj (update) w/multiple inheritance';
$s->{min_depth} = 3.5;
$s->save;
ok( $s->compare(Seaplane->fetch($s->id)), $t );

##-----  explicit is_add save with single inheritance  -----
$t = 'save obj (explicit is_add) w/single inheritance';
my $h2 = Helicopter->fetch($h->id);
$h2->remove;
$h->save( {is_add => 1} );
ok( $h->compare(Helicopter->fetch($h->id)), $t);

##-----  explicit is_add save with multiple inheritance  -----
$t = 'save obj (explicit is_add) w/multiple inheritance';
my $s2 = Seaplane->fetch($s->id);
$s2->remove;
$s->{anchor} = undef;
$s->save( {is_add => 1} );
ok( $s->compare(Seaplane->fetch($s->id)), $t );

##-- check whether failed save removes rows from parent tables.

MyObject->create_table;
my $obj = eval { MyObject->new({color => 'red', val => 1})->save };
eval { MyObject->new({color => 'red', val => 1})->save };

my $my_obj_count = MyObject->fetch_count({
							where => 'id >= ?',
							value => [ $obj->id ]
							});
my $ginsu_my_obj_count = MyBaseObject->fetch_count({
							where => 'class = ? and id >= ?',
							value => [ 'MyObject', $obj->id ]
							});

is ($my_obj_count == 1, $ginsu_my_obj_count,
					'failed save removed rows from parent table also');
$obj->remove;
MyObject->drop_table;

1;