X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fcdbi-t%2F18-has_a.t;fp=t%2Fcdbi-t%2F18-has_a.t;h=0000000000000000000000000000000000000000;hb=50891152d0b24649bfd67bdba97feec86b11c064;hp=ca7786ef863599d60eb699b03adf42f7f2ea0ba5;hpb=23209c4474d71e419b3fcf9699ae05565c2997f5;p=dbsrgits%2FDBIx-Class.git diff --git a/t/cdbi-t/18-has_a.t b/t/cdbi-t/18-has_a.t deleted file mode 100644 index ca7786e..0000000 --- a/t/cdbi-t/18-has_a.t +++ /dev/null @@ -1,240 +0,0 @@ -use strict; -use Test::More; - -BEGIN { - eval "use DBIx::Class::CDBICompat;"; - if ($@) { - plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required'); - next; - } - eval "use DBD::SQLite"; - plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 41); -} - -use lib 't/testlib'; -use Film; -use Director; -@YA::Film::ISA = 'Film'; - -Film->create_test_film; - -ok my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste"; -ok my $pj = $btaste->Director, "Bad taste has a director"; -ok !ref($pj), ' ... which is not an object'; - -ok(Film->has_a('Director' => 'Director'), "Link Director table"); -ok( - Director->create({ - Name => 'Peter Jackson', - Birthday => -300000000, - IsInsane => 1 - } - ), - 'create Director' -); - -{ - ok $btaste = Film->retrieve('Bad Taste'), "Reretrieve Bad Taste"; - ok $pj = $btaste->Director, "Bad taste now hasa() director"; - isa_ok $pj => 'Director'; - { - no warnings qw(redefine once); - local *Ima::DBI::st::execute = - sub { ::fail("Shouldn't need to query db"); }; - is $pj->id, 'Peter Jackson', 'ID already stored'; - } - ok $pj->IsInsane, "But we know he's insane"; -} - -# Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him. -my $sj = Director->create({ - Name => 'Skippy Jackson', - Birthday => (-300000000 + 60), - IsInsane => 1, - }); - -{ - eval { $btaste->Director($btaste) }; - like $@, qr/Director/, "Can't set film as director"; - is $btaste->Director->id, $pj->id, "PJ still the director"; - - # drop from cache so that next retrieve() is from db - $btaste->remove_from_object_index; -} - -{ # Still inflated after update - my $btaste = Film->retrieve('Bad Taste'); - isa_ok $btaste->Director, "Director"; - $btaste->numexplodingsheep(17); - $btaste->update; - isa_ok $btaste->Director, "Director"; - - $btaste->Director('Someone Else'); - $btaste->update; - isa_ok $btaste->Director, "Director"; - is $btaste->Director->id, "Someone Else", "Can change director"; -} - -is $sj->id, 'Skippy Jackson', 'Create new director - Skippy'; -Film->has_a('CoDirector' => 'Director'); -{ - eval { $btaste->CoDirector("Skippy Jackson") }; - is $@, "", "Auto inflates"; - isa_ok $btaste->CoDirector, "Director"; - is $btaste->CoDirector->id, $sj->id, "To skippy"; -} - -$btaste->CoDirector($sj); -$btaste->update; -is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed'); -is( - $btaste->Director->Name, - 'Peter Jackson', - "Didnt interfere with each other" -); - -{ # Inheriting hasa - my $btaste = YA::Film->retrieve('Bad Taste'); - is(ref($btaste->Director), 'Director', 'inheriting hasa()'); - is(ref($btaste->CoDirector), 'Director', 'inheriting hasa()'); - is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly'); -} - -{ - $sj = Director->retrieve('Skippy Jackson'); - $pj = Director->retrieve('Peter Jackson'); - - my $fail; - eval { - $fail = YA::Film->create({ - Title => 'Tastes Bad', - Director => $sj, - codirector => $btaste, - Rating => 'R', - NumExplodingSheep => 23 - }); - }; - ok $@, "Can't have film as codirector: $@"; - is $fail, undef, "We didn't get anything"; - - my $tastes_bad = YA::Film->create({ - Title => 'Tastes Bad', - Director => $sj, - codirector => $pj, - Rating => 'R', - NumExplodingSheep => 23 - }); - is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director'); - is( - $tastes_bad->_director_accessor->Name, - 'Skippy Jackson', - 'director_accessor' - ); - is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector'); - is( - $tastes_bad->_codirector_accessor->Name, - 'Peter Jackson', - 'codirector_accessor' - ); -} - -SKIP: { - skip "Non-standard CDBI relationships not supported by compat", 9; - { - - YA::Film->add_relationship_type(has_a => "YA::HasA"); - - package YA::HasA; - #use base 'Class::DBI::Relationship::HasA'; - - sub _inflator { - my $self = shift; - my $col = $self->accessor; - my $super = $self->SUPER::_inflator($col); - - return $super - unless $col eq $self->class->find_column('Director'); - - return sub { - my $self = shift; - $self->_attribute_store($col, 'Ghostly Peter') - if $self->_attribute_exists($col) - and not defined $self->_attrs($col); - return &$super($self); - }; - } - } - { - - package Rating; - - sub new { - my ($class, $mpaa, @details) = @_; - bless { - MPAA => $mpaa, - WHY => "@details" - }, $class; - } - sub mpaa { shift->{MPAA}; } - sub why { shift->{WHY}; } - } - local *Director::mapme = sub { - my ($class, $val) = @_; - $val =~ s/Skippy/Peter/; - $val; - }; - no warnings 'once'; - local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] }; - YA::Film->has_a( - director => 'Director', - inflate => 'mapme', - deflate => 'sanity_check' - ); - YA::Film->has_a( - rating => 'Rating', - inflate => sub { - my ($val, $parent) = @_; - my $sheep = $parent->find_column('NumexplodingSheep'); - if ($parent->_attrs($sheep) || 0 > 20) { - return new Rating 'NC17', 'Graphic ovine violence'; - } else { - return new Rating $val, 'Just because'; - } - }, - deflate => sub { - shift->mpaa; - }); - - my $tbad = YA::Film->retrieve('Tastes Bad'); - - isa_ok $tbad->Director, 'Director'; - is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle'; - $tbad->Director('Skippy Jackson'); - $tbad->update; - is $tbad->Director, 'Ghostly Peter', 'Sanity checked'; - - isa_ok $tbad->Rating, 'Rating'; - is $tbad->Rating->mpaa, 'NC17', 'Rating bumped'; - $tbad->Rating(new Rating 'NS17', 'Shaken sheep'); - no warnings 'redefine'; - local *Director::mapme = sub { - my ($class, $obj) = @_; - $obj->isa('Film') ? $obj->Director : $obj; - }; - - $pj->IsInsane(0); - $pj->update; # Hush warnings - - ok $tbad->Director($btaste), 'Cross-class mapping'; - is $tbad->Director, 'Peter Jackson', 'Yields PJ'; - $tbad->update; - - $tbad = Film->retrieve('Tastes Bad'); - ok !ref($tbad->Rating), 'Unmagical rating'; - is $tbad->Rating, 'NS17', 'but prior change stuck'; -} - -{ # Broken has_a declaration - eval { Film->has_a(driector => "Director") }; - like $@, qr/driector/, "Sensible error from has_a with incorrect column: $@"; -}