X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fcdbi-t%2F15-accessor.t;fp=t%2Fcdbi-t%2F15-accessor.t;h=3fea6e2f48ec52fad45d8d63c82708747089a074;hb=d4519f237172ad47b2251a4094b96df6cc971ba1;hp=b41e02555a38181c098b486b514ce4de7c346ec7;hpb=134ea8462a2b4147880665d23793a051e26ccd0c;p=dbsrgits%2FDBIx-Class.git diff --git a/t/cdbi-t/15-accessor.t b/t/cdbi-t/15-accessor.t index b41e025..3fea6e2 100644 --- a/t/cdbi-t/15-accessor.t +++ b/t/cdbi-t/15-accessor.t @@ -12,33 +12,33 @@ BEGIN { } INIT { - #local $SIG{__WARN__} = - #sub { like $_[0], qr/clashes with built-in method/, $_[0] }; - use lib 't/testlib'; - require Film; - require Actor; + #local $SIG{__WARN__} = + #sub { like $_[0], qr/clashes with built-in method/, $_[0] }; + use lib 't/testlib'; + require Film; + require Actor; require Director; - Actor->has_a(film => 'Film'); + Actor->has_a(film => 'Film'); Film->has_a(director => 'Director'); - sub Class::DBI::sheep { ok 0; } + sub Class::DBI::sheep { ok 0; } } sub Film::mutator_name { - my ($class, $col) = @_; - return "set_sheep" if lc $col eq "numexplodingsheep"; - return $col; + my ($class, $col) = @_; + return "set_sheep" if lc $col eq "numexplodingsheep"; + return $col; } sub Film::accessor_name { - my ($class, $col) = @_; - return "sheep" if lc $col eq "numexplodingsheep"; - return $col; + my ($class, $col) = @_; + return "sheep" if lc $col eq "numexplodingsheep"; + return $col; } sub Actor::accessor_name_for { - my ($class, $col) = @_; - return "movie" if lc $col eq "film"; - return $col; + my ($class, $col) = @_; + return "movie" if lc $col eq "film"; + return $col; } # This is a class with accessor_name_for() but no corresponding mutator_name_for() @@ -49,94 +49,94 @@ sub Director::accessor_name_for { } my $data = { - Title => 'Bad Taste', - Director => 'Peter Jackson', - Rating => 'R', + Title => 'Bad Taste', + Director => 'Peter Jackson', + Rating => 'R', }; eval { - my $data = $data; - $data->{NumExplodingSheep} = 1; - ok my $bt = Film->create($data), "Modified accessor - with column name"; - isa_ok $bt, "Film"; + my $data = $data; + $data->{NumExplodingSheep} = 1; + ok my $bt = Film->create($data), "Modified accessor - with column name"; + isa_ok $bt, "Film"; }; is $@, '', "No errors"; eval { - my $data = $data; - $data->{sheep} = 1; - ok my $bt = Film->create($data), "Modified accessor - with accessor"; - isa_ok $bt, "Film"; + my $data = $data; + $data->{sheep} = 1; + ok my $bt = Film->create($data), "Modified accessor - with accessor"; + isa_ok $bt, "Film"; }; is $@, '', "No errors"; eval { - my @film = Film->search({ sheep => 1 }); - is @film, 2, "Can search with modified accessor"; + my @film = Film->search({ sheep => 1 }); + is @film, 2, "Can search with modified accessor"; }; { - eval { - local $data->{set_sheep} = 1; - ok my $bt = Film->create($data), "Modified mutator - with mutator"; - isa_ok $bt, "Film"; - }; - is $@, '', "No errors"; - - eval { - local $data->{NumExplodingSheep} = 1; - ok my $bt = Film->create($data), "Modified mutator - with column name"; - isa_ok $bt, "Film"; - }; - is $@, '', "No errors"; - - eval { - local $data->{sheep} = 1; - ok my $bt = Film->create($data), "Modified mutator - with accessor"; - isa_ok $bt, "Film"; - }; - is $@, '', "No errors"; + eval { + local $data->{set_sheep} = 1; + ok my $bt = Film->create($data), "Modified mutator - with mutator"; + isa_ok $bt, "Film"; + }; + is $@, '', "No errors"; + + eval { + local $data->{NumExplodingSheep} = 1; + ok my $bt = Film->create($data), "Modified mutator - with column name"; + isa_ok $bt, "Film"; + }; + is $@, '', "No errors"; + + eval { + local $data->{sheep} = 1; + ok my $bt = Film->create($data), "Modified mutator - with accessor"; + isa_ok $bt, "Film"; + }; + is $@, '', "No errors"; } { - my $p_data = { - name => 'Peter Jackson', - film => 'Bad Taste', - }; - my $bt = Film->create($data); - my $ac = Actor->create($p_data); - - eval { my $f = $ac->film }; - like $@, qr/film/, "no hasa film"; - - eval { - ok my $f = $ac->movie, "hasa movie"; - isa_ok $f, "Film"; - is $f->id, $bt->id, " - Bad Taste"; - }; - is $@, '', "No errors"; - - { - local $data->{Title} = "Another film"; - my $film = Film->create($data); - - eval { $ac->film($film) }; - ok $@, $@; - - eval { $ac->movie($film) }; - ok $@, $@; - - eval { - ok $ac->set_film($film), "Set movie through hasa"; - $ac->update; - ok my $f = $ac->movie, "hasa movie"; - isa_ok $f, "Film"; - is $f->id, $film->id, " - Another Film"; - }; - is $@, '', "No problem"; - } + my $p_data = { + name => 'Peter Jackson', + film => 'Bad Taste', + }; + my $bt = Film->create($data); + my $ac = Actor->create($p_data); + + eval { my $f = $ac->film }; + like $@, qr/film/, "no hasa film"; + + eval { + ok my $f = $ac->movie, "hasa movie"; + isa_ok $f, "Film"; + is $f->id, $bt->id, " - Bad Taste"; + }; + is $@, '', "No errors"; + + { + local $data->{Title} = "Another film"; + my $film = Film->create($data); + + eval { $ac->film($film) }; + ok $@, $@; + + eval { $ac->movie($film) }; + ok $@, $@; + + eval { + ok $ac->set_film($film), "Set movie through hasa"; + $ac->update; + ok my $f = $ac->movie, "hasa movie"; + isa_ok $f, "Film"; + is $f->id, $film->id, " - Another Film"; + }; + is $@, '', "No problem"; + } } @@ -154,62 +154,62 @@ eval { } { - Film->columns(TEMP => qw/nonpersistent/); - ok(Film->find_column('nonpersistent'), "nonpersistent is a column"); - ok(!Film->has_real_column('nonpersistent'), " - but it's not real"); - - { - my $film = Film->create({ Title => "Veronique", nonpersistent => 42 }); - is $film->title, "Veronique", "Title set OK"; - is $film->nonpersistent, 42, "As is non persistent value"; - $film->remove_from_object_index; - ok $film = Film->retrieve('Veronique'), "Re-retrieve film"; - is $film->title, "Veronique", "Title still OK"; - is $film->nonpersistent, undef, "Non persistent value gone"; - ok $film->nonpersistent(40), "Can set it"; - is $film->nonpersistent, 40, "And it's there again"; - ok $film->update, "Commit the film"; - is $film->nonpersistent, 40, "And it's still there"; - } + Film->columns(TEMP => qw/nonpersistent/); + ok(Film->find_column('nonpersistent'), "nonpersistent is a column"); + ok(!Film->has_real_column('nonpersistent'), " - but it's not real"); + + { + my $film = Film->create({ Title => "Veronique", nonpersistent => 42 }); + is $film->title, "Veronique", "Title set OK"; + is $film->nonpersistent, 42, "As is non persistent value"; + $film->remove_from_object_index; + ok $film = Film->retrieve('Veronique'), "Re-retrieve film"; + is $film->title, "Veronique", "Title still OK"; + is $film->nonpersistent, undef, "Non persistent value gone"; + ok $film->nonpersistent(40), "Can set it"; + is $film->nonpersistent, 40, "And it's there again"; + ok $film->update, "Commit the film"; + is $film->nonpersistent, 40, "And it's still there"; + } } { - is_deeply( - [Actor->columns('Essential')], - [Actor->columns('Primary')], - "Actor has no specific essential columns" - ); - ok(Actor->find_column('nonpersistent'), "nonpersistent is a column"); - ok(!Actor->has_real_column('nonpersistent'), " - but it's not real"); - my $pj = eval { Actor->search(name => "Peter Jackson")->first }; - is $@, '', "no problems retrieving actors"; - isa_ok $pj => "Actor"; + is_deeply( + [Actor->columns('Essential')], + [Actor->columns('Primary')], + "Actor has no specific essential columns" + ); + ok(Actor->find_column('nonpersistent'), "nonpersistent is a column"); + ok(!Actor->has_real_column('nonpersistent'), " - but it's not real"); + my $pj = eval { Actor->search(name => "Peter Jackson")->first }; + is $@, '', "no problems retrieving actors"; + isa_ok $pj => "Actor"; } { - Film->autoupdate(1); - my $naked = Film->create({ title => 'Naked' }); - my $sandl = Film->create({ title => 'Secrets and Lies' }); - - my $rating = 1; - my $update_failure = sub { - my $obj = shift; - eval { $obj->rating($rating++) }; - return $@ =~ /read only/; - }; - - ok !$update_failure->($naked), "Can update Naked"; - ok $naked->make_read_only, "Make Naked read only"; - ok $update_failure->($naked), "Can't update Naked any more"; - ok !$update_failure->($sandl), "But can still update Secrets and Lies"; - my $july4 = eval { Film->create({ title => "4 Days in July" }) }; - isa_ok $july4 => "Film", "And can still create new films"; - - ok(Film->make_read_only, "Make all Films read only"); - ok $update_failure->($naked), "Still can't update Naked"; - ok $update_failure->($sandl), "And can't update S&L any more"; - eval { $july4->delete }; - like $@, qr/read only/, "And can't delete 4 Days in July"; - my $abigail = eval { Film->create({ title => "Abigail's Party" }) }; - like $@, qr/read only/, "Or create new films"; + Film->autoupdate(1); + my $naked = Film->create({ title => 'Naked' }); + my $sandl = Film->create({ title => 'Secrets and Lies' }); + + my $rating = 1; + my $update_failure = sub { + my $obj = shift; + eval { $obj->rating($rating++) }; + return $@ =~ /read only/; + }; + + ok !$update_failure->($naked), "Can update Naked"; + ok $naked->make_read_only, "Make Naked read only"; + ok $update_failure->($naked), "Can't update Naked any more"; + ok !$update_failure->($sandl), "But can still update Secrets and Lies"; + my $july4 = eval { Film->create({ title => "4 Days in July" }) }; + isa_ok $july4 => "Film", "And can still create new films"; + + ok(Film->make_read_only, "Make all Films read only"); + ok $update_failure->($naked), "Still can't update Naked"; + ok $update_failure->($sandl), "And can't update S&L any more"; + eval { $july4->delete }; + like $@, qr/read only/, "And can't delete 4 Days in July"; + my $abigail = eval { Film->create({ title => "Abigail's Party" }) }; + like $@, qr/read only/, "Or create new films"; }