#!/usr/bin/perl -w use strict; use Test::More tests => 55; use Scalar::Util qw(isweak refaddr); BEGIN { require 't/test-lib.pl'; use_ok('Rose::DB::Object'); } eval { require Test::Memory::Cycle }; our $HAVE_TMC = $@ ? 0 : 1; our %HAVE; my $db_type = $HAVE{'sqlite'} ? 'sqlite' : (sort keys %HAVE)[0]; SKIP: { skip("No db available", 54) unless($db_type); package MyObject; use base 'Rose::DB::Object'; __PACKAGE__->meta->table('objects'); __PACKAGE__->meta->columns ( id => { type => 'int', primary_key => 1 }, start => { type => 'scalar' }, ); __PACKAGE__->meta->initialize; sub init_db { Rose::DB->new($db_type) } package MySubObject; use base 'MyObject'; __PACKAGE__->meta->column('id')->default(123); __PACKAGE__->meta->delete_column('start'); __PACKAGE__->meta->add_column(start => { type => 'datetime' }); __PACKAGE__->meta->initialize(replace_existing => 1); package MySubObject2; use base 'MyObject'; __PACKAGE__->meta->table('s2objs'); __PACKAGE__->meta->initialize(preserve_existing => 1); sub id { my($self) = shift; return $self->{'id'} = shift if(@_); return defined $self->{'id'} ? $self->{'id'} : 456; } package MySubObject3; use base 'MySubObject'; __PACKAGE__->meta->initialize(preserve_existing => 1); package main; if($HAVE_TMC) { Test::Memory::Cycle::memory_cycle_ok(MyObject->meta, "meta memory cycle ok MyObject - $db_type"); Test::Memory::Cycle::memory_cycle_ok(MySubObject->meta, "meta memory cycle ok MySubObject - $db_type"); Test::Memory::Cycle::memory_cycle_ok(MySubObject2->meta, "meta memory cycle ok MySubObject2 - $db_type"); } else { ok(1, 'Test::Memory::Cycle not installed'); ok(1, 'Test::Memory::Cycle not installed'); ok(1, 'Test::Memory::Cycle not installed'); } ok(MyObject->meta ne MySubObject->meta, "meta 1 - $db_type"); ok(MyObject->meta ne MySubObject2->meta, "meta 2 - $db_type"); ok(MySubObject->meta ne MySubObject2->meta, "meta 3 - $db_type"); ok(refaddr(MyObject->meta->column('id')) ne refaddr(MySubObject->meta->column('id')), "meta column 1 - $db_type"); ok(refaddr(MyObject->meta->column('id')) ne refaddr(MySubObject2->meta->column('id')), "meta column 2 - $db_type"); ok(refaddr(MySubObject->meta->column('id')) ne refaddr(MySubObject2->meta->column('id')), "meta column 3 - $db_type"); ok(isweak(MyObject->meta->column('id')->{'parent'}), "meta weakened 1 - $db_type"); ok(isweak(MySubObject->meta->column('id')->{'parent'}), "meta weakened 2 - $db_type"); ok(isweak(MySubObject2->meta->column('id')->{'parent'}), "meta weakened 3 - $db_type"); is(refaddr(MyObject->meta->column('id')->parent), refaddr(MyObject->meta), "meta parent 1 - $db_type"); is(refaddr(MySubObject->meta->column('id')->parent), refaddr(MySubObject->meta), "meta parent 2 - $db_type"); is(refaddr(MySubObject2->meta->column('id')->parent), refaddr(MySubObject2->meta), "meta parent 3 - $db_type"); my $o = MyObject->new; is(MyObject->meta->table, 'objects', "base class 1 - $db_type"); ok(!defined $o->id, "base class 2 - $db_type"); $o->start('1/2/2003'); is($o->start, '1/2/2003', "base class 3 - $db_type"); my $s = MySubObject->new; is(MyObject->meta->table, 'objects', "subclass 1.1 - $db_type"); is($s->id, 123, "subclass 1.2 - $db_type"); $s->start('1/2/2003'); is($s->start->strftime('%B'), 'January', "subclass 1.3 - $db_type"); my $t = MySubObject2->new; is(MySubObject2->meta->table, 's2objs', "subclass 2.1 - $db_type"); is($t->id, 456, "subclass 2.2 - $db_type"); $t->start('1/2/2003'); is($t->start, '1/2/2003', "subclass 2.3 - $db_type"); my $f = MySubObject3->new; is(MySubObject3->meta->table, 'objects', "subclass 3.1 - $db_type"); is($f->id, 123, "subclass 3.2 - $db_type"); $f->start('1/2/2003'); is($f->start->strftime('%B'), 'January', "subclass 3.3 - $db_type"); # Test again, but without this module $Scalar::Util::Clone::VERSION = undef; package My2Object; use base 'Rose::DB::Object'; __PACKAGE__->meta->table('objects'); __PACKAGE__->meta->columns ( id => { type => 'int', primary_key => 1 }, start => { type => 'scalar' }, ); __PACKAGE__->meta->initialize; sub init_db { Rose::DB->new($db_type) } package My2SubObject; use base 'My2Object'; __PACKAGE__->meta->column('id')->default(123); __PACKAGE__->meta->delete_column('start'); __PACKAGE__->meta->add_column(start => { type => 'datetime' }); __PACKAGE__->meta->initialize(replace_existing => 1); package My2SubObject2; use base 'My2Object'; __PACKAGE__->meta->table('s2objs'); __PACKAGE__->meta->initialize(preserve_existing => 1); sub id { my($self) = shift; return $self->{'id'} = shift if(@_); return defined $self->{'id'} ? $self->{'id'} : 456; } package My2SubObject3; use base 'My2SubObject'; __PACKAGE__->meta->initialize(preserve_existing => 1); package main; if($HAVE_TMC) { Test::Memory::Cycle::memory_cycle_ok(My2Object->meta, "meta memory cycle ok My2Object - $db_type"); Test::Memory::Cycle::memory_cycle_ok(My2SubObject->meta, "meta memory cycle ok My2SubObject - $db_type"); Test::Memory::Cycle::memory_cycle_ok(My2SubObject2->meta, "meta memory cycle ok My2SubObject2 - $db_type"); } else { ok(1, 'Test::Memory::Cycle not installed'); ok(1, 'Test::Memory::Cycle not installed'); ok(1, 'Test::Memory::Cycle not installed'); } ok(My2Object->meta ne My2SubObject->meta, "meta 1 - $db_type"); ok(My2Object->meta ne My2SubObject2->meta, "meta 2 - $db_type"); ok(My2SubObject->meta ne My2SubObject2->meta, "meta 3 - $db_type"); ok(refaddr(My2Object->meta->column('id')) ne refaddr(My2SubObject->meta->column('id')), "meta column 1 - $db_type"); ok(refaddr(My2Object->meta->column('id')) ne refaddr(My2SubObject2->meta->column('id')), "meta column 2 - $db_type"); ok(refaddr(My2SubObject->meta->column('id')) ne refaddr(My2SubObject2->meta->column('id')), "meta column 3 - $db_type"); ok(isweak(My2Object->meta->column('id')->{'parent'}), "meta weakened 1 - $db_type"); ok(isweak(My2SubObject->meta->column('id')->{'parent'}), "meta weakened 2 - $db_type"); ok(isweak(My2SubObject2->meta->column('id')->{'parent'}), "meta weakened 3 - $db_type"); is(refaddr(My2Object->meta->column('id')->parent), refaddr(My2Object->meta), "meta parent 1 - $db_type"); is(refaddr(My2SubObject->meta->column('id')->parent), refaddr(My2SubObject->meta), "meta parent 2 - $db_type"); is(refaddr(My2SubObject2->meta->column('id')->parent), refaddr(My2SubObject2->meta), "meta parent 3 - $db_type"); $o = My2Object->new; is(My2Object->meta->table, 'objects', "base class 1 - $db_type"); ok(!defined $o->id, "base class 2 - $db_type"); $o->start('1/2/2003'); is($o->start, '1/2/2003', "base class 3 - $db_type"); $s = My2SubObject->new; is(My2Object->meta->table, 'objects', "subclass 1.1 - $db_type"); is($s->id, 123, "subclass 1.2 - $db_type"); $s->start('1/2/2003'); is($s->start->strftime('%B'), 'January', "subclass 1.3 - $db_type"); $t = My2SubObject2->new; is(My2SubObject2->meta->table, 's2objs', "subclass 2.1 - $db_type"); is($t->id, 456, "subclass 2.2 - $db_type"); $t->start('1/2/2003'); is($t->start, '1/2/2003', "subclass 2.3 - $db_type"); $f = My2SubObject3->new; is(My2SubObject3->meta->table, 'objects', "subclass 3.1 - $db_type"); is($f->id, 123, "subclass 3.2 - $db_type"); $f->start('1/2/2003'); is($f->start->strftime('%B'), 'January', "subclass 3.3 - $db_type"); } BEGIN { our %HAVE; # # PostgreSQL # my $dbh; eval { $dbh = Rose::DB->new('pg_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'pg'} = 1; } # # MySQL # eval { $dbh = Rose::DB->new('mysql_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'mysql'} = 1; } # # SQLite # eval { $dbh = Rose::DB->new('sqlite_admin')->retain_dbh() or die Rose::DB->error; }; if(!$@ && $dbh) { $HAVE{'sqlite'} = 1; } }