#!/usr/bin/perl use lib "t"; use Test::More tests => 20; BEGIN { use_ok( 'Test::Dummy' ); use_ok( 'Test::Dummy::Child1' ); } #ORM::DbLog->write_to_stdout( 1 ); #Test::Dummy->_cache->change_size( 0 ); my $error; my $d1; my $d2; # TEST new # # simple new statement for primary class $error = ORM::Error->new; $d1 = Test::Dummy->new( prop=>{ a=>'a', b=>'b', c=>'c' }, error=>$error ); ok ( !$error->fatal && $d1 && $d1->a eq 'a' && $d1->b eq 'b' && $d1->c eq 'c', 'new' ); # TEST update # # simple update statement $error = ORM::Error->new; $d1->update( prop=>{ a=>'aa', b=>'bb' }, error=>$error ); ok ( !$error->fatal && $d1 && $d1->a eq 'aa' && $d1->b eq 'bb' && $d1->c eq 'c', 'update' ); # TEST update # # update with successfull test of current values $error = ORM::Error->new; $d1->update ( prop => { b=>undef }, old_prop => { a=>'aa', b=>'bb', c=>'c' }, error => $error, ); ok ( !$error->fatal && $d1 && $d1->a eq 'aa' && ! defined $d1->b && $d1->c eq 'c', 'update' ); # TEST update # # update with faulty test of current values $error = ORM::Error->new; $d1->update ( prop => { b=>'bbb' }, old_prop => { a=>'aa', b=>'bb', c=>'c' }, error => $error ); ok ( ( $d1 && $d1->a eq 'aa' && ! defined $d1->b && $d1->c eq 'c' && $error->text =~ / do not match properties assumed by user\n$/ ), 'update' ); # TEST delete # # simple delete statement $error = ORM::Error->new; $d1->delete( error=>$error ); ok( !$error->fatal, 'delete' ); # TEST new # # new for non-primary class $error = ORM::Error->new; $d1 = Test::Dummy::Child1->new ( prop => { a=>'a', b=>'b', c=>'c', ca=>'ca', cb=>'cb' }, error => $error ); ok ( !$error->fatal && $d1 && $d1->a eq 'a' && $d1->b eq 'b' && $d1->c eq 'c' && $d1->ca eq 'ca' && $d1->cb eq 'cb', 'new' ); # TEST lazy_load # # non-lazy loading $error = ORM::Error->new; $d1 = Test::Dummy->find ( filter => (Test::Dummy->M->id == $d1->id), error => $error, lazy_load => 0, ); ok ( !$error->fatal && ! exists $d1->{_ORM_missing_tables} && ref $d1 eq 'Test::Dummy::Child1' && $d1->{_ORM_data}{ca} eq 'ca', 'lazy_load' ); # TEST lazy_load # # not loaded second table $d1->_cache->delete( $d1 ); $error = ORM::Error->new; $d1 = Test::Dummy->find ( filter => ( Test::Dummy->M->id == $d1->id ), error => $error, lazy_load => 1 ); ok ( !$error->fatal && missing_tables_str( $d1 ) eq 'Dummy__Child1', 'lazy_load', ); # TEST lazy_load # # finish loading of lazy-loaded table $d1->ca( error=>$error ); ok( !$error->fatal && ! exists $d1->{_ORM_missing_tables}, 'lazy_load' ); # TEST lazy_load # # non-lazy load with find_id $d1->_cache->delete( $d1 ); $error = ORM::Error->new; $d1 = Test::Dummy->find_id( id=>$d1->id, error=>$error ); ok ( !$error->fatal && ! exists $d1->{_ORM_missing_tables} && ref $d1 eq 'Test::Dummy::Child1' && $d1->{_ORM_data}{ca} eq 'ca', 'lazy_load' ); # TEST lazy_load # # lazy load with find_id from base class $d1->_cache->delete( $d1 ); $error = ORM::Error->new; $d1 = Test::Dummy->find_id( id=>$d1->id, error=>$error, lazy_load=>1 ); ok ( !$error->fatal && missing_tables_str( $d1 ) eq 'Dummy' && ref $d1 eq 'Test::Dummy', 'lazy_load' ); # TEST lazy_load # # first stage load after find_id $d1->c( error=>$error ); ok ( missing_tables_str( $d1 ) eq 'Dummy__Child1' && ref $d1 eq 'Test::Dummy::Child1' && $d1->{_ORM_data}{c} eq 'c', 'lazy_load' ); # TEST lazy_load # # second stage load after find_id $d1->ca( error=>$error ); ok ( ! exists $d1->{_ORM_missing_tables} && ref $d1 eq 'Test::Dummy::Child1' && $d1->{_ORM_data}{ca} eq 'ca', 'lazy_load' ); # TEST lazy_load # # lazy load with find_id from exact class $d1->_cache->delete( $d1 ); $error = ORM::Error->new; $d1 = Test::Dummy::Child1->find_id( id=>$d1->id, error=>$error, lazy_load=>1 ); ok ( !$error->fatal && missing_tables_str( $d1 ) eq 'Dummy,Dummy__Child1', 'lazy_load' ); # TEST update # # update of lazy loaded object $error = ORM::Error->new; $d1->update( prop=>{ a=>'aa', ca=>'cccaaa' }, error=>$error ); ok ( !$error->fatal && $d1 && $d1->a eq 'aa' && $d1->ca eq 'cccaaa', 'update' ); # TEST update # # update of non-primary class $error = ORM::Error->new; $d1->update( prop=>{ ca=>'ccaa' }, error=>$error ); ok( !$error->fatal && $d1 && $d1->ca eq 'ccaa', 'update' ); # TEST server_side_update $error = ORM::Error->new; $d1->update( prop=>{ ca=>($d1->M->ca)->_append( 'aa' ) }, error=>$error ); ok( !$error->fatal && $d1 && $d1->ca eq 'ccaaaa', 'server_side_update' ); # TEST delete $error = ORM::Error->new; $d1->delete( error=>$error ); ok( !$error->fatal, 'delete' ); # SUBROUTINES sub missing_tables_str { my $d1 = shift; join ',', ( exists $d1->{_ORM_missing_tables} && sort keys %{$d1->{_ORM_missing_tables}} ) }