From: Peter Rabbitson Date: Fri, 22 Jan 2010 10:11:49 +0000 (+0000) Subject: Final round of detabify X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6a3bf2519832866d037740c5fb22341dad6f8bb3;p=dbsrgits%2FDBIx-Class-Historic.git Final round of detabify --- diff --git a/t/cdbi/01-columns.t b/t/cdbi/01-columns.t index 61c7b90..e0c362b 100644 --- a/t/cdbi/01-columns.t +++ b/t/cdbi/01-columns.t @@ -24,15 +24,15 @@ State->columns(Other => qw/Capital Population/); #State->has_many(cities => "City"); sub accessor_name_for { - my ($class, $column) = @_; - my $return = $column eq "Rain" ? "Rainfall" : $column; - return $return; + my ($class, $column) = @_; + my $return = $column eq "Rain" ? "Rainfall" : $column; + return $return; } sub mutator_name_for { - my ($class, $column) = @_; - my $return = $column eq "Rain" ? "set_Rainfall" : "set_$column"; - return $return; + my ($class, $column) = @_; + my $return = $column eq "Rain" ? "set_Rainfall" : "set_$column"; + return $return; } sub Snowfall { 1 } @@ -69,61 +69,61 @@ package main; is(State->table, 'State', 'State table()'); is(State->primary_column, 'name', 'State primary()'); is_deeply [ State->columns('Primary') ] => [qw/name/], - 'State Primary:' . join ", ", State->columns('Primary'); + 'State Primary:' . join ", ", State->columns('Primary'); is_deeply [ sort State->columns('Essential') ] => [qw/abbreviation name/], - 'State Essential:' . join ", ", State->columns('Essential'); + 'State Essential:' . join ", ", State->columns('Essential'); is_deeply [ sort State->columns('All') ] => - [ sort qw/name abbreviation rain snowfall capital population/ ], - 'State All:' . join ", ", State->columns('All'); + [ sort qw/name abbreviation rain snowfall capital population/ ], + 'State All:' . join ", ", State->columns('All'); is(CD->primary_column, 'artist', 'CD primary()'); is_deeply [ CD->columns('Primary') ] => [qw/artist/], - 'CD primary:' . join ", ", CD->columns('Primary'); + 'CD primary:' . join ", ", CD->columns('Primary'); is_deeply [ sort CD->columns('All') ] => [qw/artist length title/], - 'CD all:' . join ", ", CD->columns('All'); + 'CD all:' . join ", ", CD->columns('All'); is_deeply [ sort CD->columns('Essential') ] => [qw/artist/], - 'CD essential:' . join ", ", CD->columns('Essential'); + 'CD essential:' . join ", ", CD->columns('Essential'); ok(State->find_column('Rain'), 'find_column Rain'); ok(State->find_column('rain'), 'find_column rain'); ok(!State->find_column('HGLAGAGlAG'), '!find_column HGLAGAGlAG'); { - + can_ok +State => qw/Rainfall _Rainfall_accessor set_Rainfall - _set_Rainfall_accessor Snowfall _Snowfall_accessor set_Snowfall - _set_Snowfall_accessor/; - - foreach my $method (qw/Rain _Rain_accessor rain snowfall/) { - ok !State->can($method), "State can't $method"; + _set_Rainfall_accessor Snowfall _Snowfall_accessor set_Snowfall + _set_Snowfall_accessor/; + + foreach my $method (qw/Rain _Rain_accessor rain snowfall/) { + ok !State->can($method), "State can't $method"; } } { - SKIP: { - skip "No column objects", 1; + SKIP: { + skip "No column objects", 1; - eval { my @grps = State->__grouper->groups_for("Huh"); }; - ok $@, "Huh not in groups"; - } + eval { my @grps = State->__grouper->groups_for("Huh"); }; + ok $@, "Huh not in groups"; + } - my @grps = sort State->__grouper->groups_for(State->_find_columns(qw/rain capital/)); - is @grps, 2, "Rain and Capital = 2 groups"; + my @grps = sort State->__grouper->groups_for(State->_find_columns(qw/rain capital/)); + is @grps, 2, "Rain and Capital = 2 groups"; @grps = sort @grps; # Because the underlying API is hash-based - is $grps[0], 'Other', " - Other"; - is $grps[1], 'Weather', " - Weather"; + is $grps[0], 'Other', " - Other"; + is $grps[1], 'Weather', " - Weather"; } #{ -# +# # package DieTest; # @DieTest::ISA = qw(DBIx::Class); # DieTest->load_components(qw/CDBICompat::Retrieve Core/); # package main; -# local $SIG{__WARN__} = sub { }; -# eval { DieTest->retrieve(1) }; -# like $@, qr/unless primary columns are defined/, "Need primary key for retrieve"; +# local $SIG{__WARN__} = sub { }; +# eval { DieTest->retrieve(1) }; +# like $@, qr/unless primary columns are defined/, "Need primary key for retrieve"; #} #----------------------------------------------------------------------- diff --git a/t/cdbi/02-Film.t b/t/cdbi/02-Film.t index 5b44328..3a4d70a 100644 --- a/t/cdbi/02-Film.t +++ b/t/cdbi/02-Film.t @@ -12,28 +12,28 @@ BEGIN { } INIT { - use lib 't/cdbi/testlib'; - use Film; + use lib 't/cdbi/testlib'; + use Film; } ok(Film->can('db_Main'), 'set_db()'); is(Film->__driver, "SQLite", "Driver set correctly"); { - my $nul = eval { Film->retrieve() }; - is $nul, undef, "Can't retrieve nothing"; - like $@, qr/./, "retrieve needs parameters"; # TODO fix this... + my $nul = eval { Film->retrieve() }; + is $nul, undef, "Can't retrieve nothing"; + like $@, qr/./, "retrieve needs parameters"; # TODO fix this... } { - eval { my $id = Film->id }; - like $@, qr/class method/, "Can't get id with no object"; + eval { my $id = Film->id }; + like $@, qr/class method/, "Can't get id with no object"; } { - eval { my $id = Film->title }; - #like $@, qr/class method/, "Can't get title with no object"; - ok $@, "Can't get title with no object"; + eval { my $id = Film->title }; + #like $@, qr/class method/, "Can't get title with no object"; + ok $@, "Can't get title with no object"; } eval { my $duh = Film->insert; }; @@ -49,24 +49,24 @@ is($btaste->Rating, 'R', 'Rating() get'); is($btaste->NumExplodingSheep, 1, 'NumExplodingSheep() get'); { - my $bt2 = Film->find_or_create(Title => 'Bad Taste'); - is $bt2->Director, $btaste->Director, "find_or_create"; - my @bt = Film->search(Title => 'Bad Taste'); - is @bt, 1, " doesn't create a new one"; + my $bt2 = Film->find_or_create(Title => 'Bad Taste'); + is $bt2->Director, $btaste->Director, "find_or_create"; + my @bt = Film->search(Title => 'Bad Taste'); + is @bt, 1, " doesn't create a new one"; } ok my $gone = Film->find_or_create( - { - Title => 'Gone With The Wind', - Director => 'Bob Baggadonuts', - Rating => 'PG', - NumExplodingSheep => 0 - } - ), - "Add Gone With The Wind"; + { + Title => 'Gone With The Wind', + Director => 'Bob Baggadonuts', + Rating => 'PG', + NumExplodingSheep => 0 + } + ), + "Add Gone With The Wind"; isa_ok $gone, 'Film'; ok $gone = Film->retrieve(Title => 'Gone With The Wind'), - "Fetch it back again"; + "Fetch it back again"; isa_ok $gone, 'Film'; # Shocking new footage found reveals bizarre Scarlet/sheep scene! @@ -81,8 +81,8 @@ is($gone->Rating, 'NC-17', 'Rating() set'); $gone->update; { - my @films = eval { Film->retrieve_all }; - cmp_ok(@films, '==', 2, "We have 2 films in total"); + my @films = eval { Film->retrieve_all }; + cmp_ok(@films, '==', 2, "We have 2 films in total"); } # EXTRA TEST: added by mst to check a bug found by Numa @@ -94,11 +94,11 @@ ok($gone->Rating eq 'NC-17', 'update() again'); # Grab the 'Bladerunner' entry. Film->create( - { - Title => 'Bladerunner', - Director => 'Bob Ridley Scott', - Rating => 'R' - } + { + Title => 'Bladerunner', + Director => 'Bob Ridley Scott', + Rating => 'R' + } ); my $blrunner = Film->retrieve('Bladerunner'); @@ -110,10 +110,10 @@ is $blrunner->NumExplodingSheep, undef, " and sheep"; # Make a copy of 'Bladerunner' and create an entry of the directors cut my $blrunner_dc = $blrunner->copy( - { - title => "Bladerunner: Director's Cut", - rating => "15", - } + { + title => "Bladerunner: Director's Cut", + rating => "15", + } ); is(ref $blrunner_dc, 'Film', "copy() produces a film"); is($blrunner_dc->Title, "Bladerunner: Director's Cut", 'Title correct'); @@ -123,78 +123,78 @@ is($blrunner_dc->NumExplodingSheep, undef, 'Sheep correct'); # Set up own SQL: { - Film->add_constructor(title_asc => "title LIKE ? ORDER BY title"); - Film->add_constructor(title_desc => "title LIKE ? ORDER BY title DESC"); + Film->add_constructor(title_asc => "title LIKE ? ORDER BY title"); + Film->add_constructor(title_desc => "title LIKE ? ORDER BY title DESC"); Film->add_constructor(title_asc_nl => q{ title LIKE ? ORDER BY title LIMIT 1 }); - { - my @films = Film->title_asc("Bladerunner%"); - is @films, 2, "We have 2 Bladerunners"; - is $films[0]->Title, $blrunner->Title, "Ordered correctly"; - } - { - my @films = Film->title_desc("Bladerunner%"); - is @films, 2, "We have 2 Bladerunners"; - is $films[0]->Title, $blrunner_dc->Title, "Ordered correctly"; - } - { - my @films = Film->title_asc_nl("Bladerunner%"); - is @films, 1, "We have 2 Bladerunners"; - is $films[0]->Title, $blrunner->Title, "Ordered correctly"; - } + { + my @films = Film->title_asc("Bladerunner%"); + is @films, 2, "We have 2 Bladerunners"; + is $films[0]->Title, $blrunner->Title, "Ordered correctly"; + } + { + my @films = Film->title_desc("Bladerunner%"); + is @films, 2, "We have 2 Bladerunners"; + is $films[0]->Title, $blrunner_dc->Title, "Ordered correctly"; + } + { + my @films = Film->title_asc_nl("Bladerunner%"); + is @films, 1, "We have 2 Bladerunners"; + is $films[0]->Title, $blrunner->Title, "Ordered correctly"; + } } # Multi-column search { - my @films = $blrunner->search (title => { -like => "Bladerunner%"}, rating => '15'); - is @films, 1, "Only one Bladerunner is a 15"; + my @films = $blrunner->search (title => { -like => "Bladerunner%"}, rating => '15'); + is @films, 1, "Only one Bladerunner is a 15"; } # Inline SQL { - my @films = Film->retrieve_from_sql("numexplodingsheep > 0 ORDER BY title"); - is @films, 2, "Inline SQL"; - is $films[0]->id, $btaste->id, "Correct film"; - is $films[1]->id, $gone->id, "Correct film"; + my @films = Film->retrieve_from_sql("numexplodingsheep > 0 ORDER BY title"); + is @films, 2, "Inline SQL"; + is $films[0]->id, $btaste->id, "Correct film"; + is $films[1]->id, $gone->id, "Correct film"; } # Inline SQL removes WHERE { - my @films = - Film->retrieve_from_sql(" WHErE numexplodingsheep > 0 ORDER BY title"); - is @films, 2, "Inline SQL"; - is $films[0]->id, $btaste->id, "Correct film"; - is $films[1]->id, $gone->id, "Correct film"; + my @films = + Film->retrieve_from_sql(" WHErE numexplodingsheep > 0 ORDER BY title"); + is @films, 2, "Inline SQL"; + is $films[0]->id, $btaste->id, "Correct film"; + is $films[1]->id, $gone->id, "Correct film"; } eval { - my $ishtar = Film->insert({ Title => 'Ishtar', Director => 'Elaine May' }); - my $mandn = - Film->insert({ Title => 'Mikey and Nicky', Director => 'Elaine May' }); - my $new_leaf = - Film->insert({ Title => 'A New Leaf', Director => 'Elaine May' }); + my $ishtar = Film->insert({ Title => 'Ishtar', Director => 'Elaine May' }); + my $mandn = + Film->insert({ Title => 'Mikey and Nicky', Director => 'Elaine May' }); + my $new_leaf = + Film->insert({ Title => 'A New Leaf', Director => 'Elaine May' }); #use Data::Dumper; die Dumper(Film->search( Director => 'Elaine May' )); - cmp_ok(Film->search(Director => 'Elaine May'), '==', 3, - "3 Films by Elaine May"); - ok(Film->retrieve('Ishtar')->delete, - "Ishtar doesn't deserve an entry any more"); - ok(!Film->retrieve('Ishtar'), 'Ishtar no longer there'); - { - my $deprecated = 0; - local $SIG{__WARN__} = sub { $deprecated++ if $_[0] =~ /deprecated/ }; - ok( - Film->delete(Director => 'Elaine May'), - "In fact, delete all films by Elaine May" - ); - cmp_ok(Film->search(Director => 'Elaine May'), '==', - 0, "0 Films by Elaine May"); - is $deprecated, 0, "No deprecated warnings from compat layer"; - } + cmp_ok(Film->search(Director => 'Elaine May'), '==', 3, + "3 Films by Elaine May"); + ok(Film->retrieve('Ishtar')->delete, + "Ishtar doesn't deserve an entry any more"); + ok(!Film->retrieve('Ishtar'), 'Ishtar no longer there'); + { + my $deprecated = 0; + local $SIG{__WARN__} = sub { $deprecated++ if $_[0] =~ /deprecated/ }; + ok( + Film->delete(Director => 'Elaine May'), + "In fact, delete all films by Elaine May" + ); + cmp_ok(Film->search(Director => 'Elaine May'), '==', + 0, "0 Films by Elaine May"); + is $deprecated, 0, "No deprecated warnings from compat layer"; + } }; is $@, '', "No problems with deletes"; @@ -207,23 +207,23 @@ is($films[0]->id, $gone->id, ' ... the correct one'); @films = Film->search ( { 'Director' => { -like => 'Bob %' } }); is(scalar @films, 3, ' search_like returns 3 films'); ok( - eq_array( - [ sort map { $_->id } @films ], - [ sort map { $_->id } $blrunner_dc, $gone, $blrunner ] - ), - 'the correct ones' + eq_array( + [ sort map { $_->id } @films ], + [ sort map { $_->id } $blrunner_dc, $gone, $blrunner ] + ), + 'the correct ones' ); # Find Ridley Scott films which don't have vomit @films = - Film->search(numExplodingSheep => undef, Director => 'Bob Ridley Scott'); + Film->search(numExplodingSheep => undef, Director => 'Bob Ridley Scott'); is(scalar @films, 2, ' search where attribute is null returns 2 films'); ok( - eq_array( - [ sort map { $_->id } @films ], - [ sort map { $_->id } $blrunner_dc, $blrunner ] - ), - 'the correct ones' + eq_array( + [ sort map { $_->id } @films ], + [ sort map { $_->id } $blrunner_dc, $blrunner ] + ), + 'the correct ones' ); # Test that a disconnect doesnt harm anything. @@ -248,166 +248,166 @@ ok( } SKIP: { - skip "ActiveState perl produces additional warnings", 3 + skip "ActiveState perl produces additional warnings", 3 if ($^O eq 'MSWin32'); - Film->autoupdate(1); - my $btaste2 = Film->retrieve($btaste->id); - $btaste->NumExplodingSheep(18); - my @warnings; - local $SIG{__WARN__} = sub { push(@warnings, @_); }; - { - - # unhook from live object cache, so next one is not from cache - $btaste2->remove_from_object_index; - my $btaste3 = Film->retrieve($btaste->id); - is $btaste3->NumExplodingSheep, 18, "Class based AutoCommit"; - $btaste3->autoupdate(0); # obj a/c should override class a/c - is @warnings, 0, "No warnings so far"; - $btaste3->NumExplodingSheep(13); - } - is @warnings, 1, "DESTROY without update warns"; - Film->autoupdate(0); + Film->autoupdate(1); + my $btaste2 = Film->retrieve($btaste->id); + $btaste->NumExplodingSheep(18); + my @warnings; + local $SIG{__WARN__} = sub { push(@warnings, @_); }; + { + + # unhook from live object cache, so next one is not from cache + $btaste2->remove_from_object_index; + my $btaste3 = Film->retrieve($btaste->id); + is $btaste3->NumExplodingSheep, 18, "Class based AutoCommit"; + $btaste3->autoupdate(0); # obj a/c should override class a/c + is @warnings, 0, "No warnings so far"; + $btaste3->NumExplodingSheep(13); + } + is @warnings, 1, "DESTROY without update warns"; + Film->autoupdate(0); } { # update unchanged object - my $film = Film->retrieve($btaste->id); - my $retval = $film->update; - is $retval, -1, "Unchanged object"; + my $film = Film->retrieve($btaste->id); + my $retval = $film->update; + is $retval, -1, "Unchanged object"; } { # update deleted object - my $rt = "Royal Tenenbaums"; - my $ten = Film->insert({ title => $rt, Rating => "R" }); - $ten->rating(18); - Film->set_sql(drt => "DELETE FROM __TABLE__ WHERE title = ?"); - Film->sql_drt->execute($rt); - my @films = Film->search({ title => $rt }); - is @films, 0, "RT gone"; - my $retval = eval { $ten->update }; - like $@, qr/row not found/, "Update deleted object throws error"; - $ten->discard_changes; + my $rt = "Royal Tenenbaums"; + my $ten = Film->insert({ title => $rt, Rating => "R" }); + $ten->rating(18); + Film->set_sql(drt => "DELETE FROM __TABLE__ WHERE title = ?"); + Film->sql_drt->execute($rt); + my @films = Film->search({ title => $rt }); + is @films, 0, "RT gone"; + my $retval = eval { $ten->update }; + like $@, qr/row not found/, "Update deleted object throws error"; + $ten->discard_changes; } { - $btaste->autoupdate(1); - $btaste->NumExplodingSheep(32); - my $btaste2 = Film->retrieve($btaste->id); - is $btaste2->NumExplodingSheep, 32, "Object based AutoCommit"; - $btaste->autoupdate(0); + $btaste->autoupdate(1); + $btaste->NumExplodingSheep(32); + my $btaste2 = Film->retrieve($btaste->id); + is $btaste2->NumExplodingSheep, 32, "Object based AutoCommit"; + $btaste->autoupdate(0); } # Primary key of 0 { - my $zero = Film->insert({ Title => 0, Rating => "U" }); - ok defined $zero, "Create 0"; - ok my $ret = Film->retrieve(0), "Retrieve 0"; - is $ret->Title, 0, "Title OK"; - is $ret->Rating, "U", "Rating OK"; + my $zero = Film->insert({ Title => 0, Rating => "U" }); + ok defined $zero, "Create 0"; + ok my $ret = Film->retrieve(0), "Retrieve 0"; + is $ret->Title, 0, "Title OK"; + is $ret->Rating, "U", "Rating OK"; } # Change after_update policy SKIP: { skip "DBIx::Class compat doesn't handle the exists stuff quite right yet", 4; - my $bt = Film->retrieve($btaste->id); - $bt->autoupdate(1); - - $bt->rating("17"); - ok !$bt->_attribute_exists('rating'), "changed column needs reloaded"; - ok $bt->_attribute_exists('title'), "but we still have the title"; - - # Don't re-load - $bt->add_trigger( - after_update => sub { - my ($self, %args) = @_; - my $discard_columns = $args{discard_columns}; - @$discard_columns = qw/title/; - } - ); - $bt->rating("19"); - ok $bt->_attribute_exists('rating'), "changed column needs reloaded"; - ok !$bt->_attribute_exists('title'), "but no longer have the title"; + my $bt = Film->retrieve($btaste->id); + $bt->autoupdate(1); + + $bt->rating("17"); + ok !$bt->_attribute_exists('rating'), "changed column needs reloaded"; + ok $bt->_attribute_exists('title'), "but we still have the title"; + + # Don't re-load + $bt->add_trigger( + after_update => sub { + my ($self, %args) = @_; + my $discard_columns = $args{discard_columns}; + @$discard_columns = qw/title/; + } + ); + $bt->rating("19"); + ok $bt->_attribute_exists('rating'), "changed column needs reloaded"; + ok !$bt->_attribute_exists('title'), "but no longer have the title"; } # Make sure that we can have other accessors. (Bugfix in 0.28) if (0) { - Film->mk_accessors(qw/temp1 temp2/); - my $blrunner = Film->retrieve('Bladerunner'); - $blrunner->temp1("Foo"); - $blrunner->NumExplodingSheep(2); - eval { $blrunner->update }; - ok(!$@, "Other accessors"); + Film->mk_accessors(qw/temp1 temp2/); + my $blrunner = Film->retrieve('Bladerunner'); + $blrunner->temp1("Foo"); + $blrunner->NumExplodingSheep(2); + eval { $blrunner->update }; + ok(!$@, "Other accessors"); } # overloading { - is "$blrunner", "Bladerunner", "stringify"; + is "$blrunner", "Bladerunner", "stringify"; - ok(Film->columns(Stringify => 'rating'), "Can change stringify column"); - is "$blrunner", "R", "And still stringifies correctly"; + ok(Film->columns(Stringify => 'rating'), "Can change stringify column"); + is "$blrunner", "R", "And still stringifies correctly"; - ok( - Film->columns(Stringify => qw/title rating/), - "Can have multiple stringify columns" - ); - is "$blrunner", "Bladerunner/R", "And still stringifies correctly"; + ok( + Film->columns(Stringify => qw/title rating/), + "Can have multiple stringify columns" + ); + is "$blrunner", "Bladerunner/R", "And still stringifies correctly"; - no warnings 'once'; - local *Film::stringify_self = sub { join ":", $_[0]->title, $_[0]->rating }; - is "$blrunner", "Bladerunner:R", "Provide stringify_self()"; + no warnings 'once'; + local *Film::stringify_self = sub { join ":", $_[0]->title, $_[0]->rating }; + is "$blrunner", "Bladerunner:R", "Provide stringify_self()"; } { - { - ok my $byebye = DeletingFilm->insert( - { - Title => 'Goodbye Norma Jean', - Rating => 'PG', - } - ), - "Add a deleting Film"; - - isa_ok $byebye, 'DeletingFilm'; - isa_ok $byebye, 'Film'; - ok(Film->retrieve('Goodbye Norma Jean'), "Fetch it back again"); - } - my $film; - eval { $film = Film->retrieve('Goodbye Norma Jean') }; - ok !$film, "It destroys itself"; + { + ok my $byebye = DeletingFilm->insert( + { + Title => 'Goodbye Norma Jean', + Rating => 'PG', + } + ), + "Add a deleting Film"; + + isa_ok $byebye, 'DeletingFilm'; + isa_ok $byebye, 'Film'; + ok(Film->retrieve('Goodbye Norma Jean'), "Fetch it back again"); + } + my $film; + eval { $film = Film->retrieve('Goodbye Norma Jean') }; + ok !$film, "It destroys itself"; } SKIP: { skip "Caching has been removed", 5 if Film->isa("DBIx::Class::CDBICompat::NoObjectIndex"); - # my bad taste is your bad taste - my $btaste = Film->retrieve('Bad Taste'); - my $btaste2 = Film->retrieve('Bad Taste'); - is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2), - "Retrieving twice gives ref to same object"; - - my ($btaste5) = Film->search(title=>'Bad Taste'); - is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste5), - "Searching also gives ref to same object"; - - $btaste2->remove_from_object_index; - my $btaste3 = Film->retrieve('Bad Taste'); - isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste3), - "Removing from object_index and retrieving again gives new object"; - - $btaste3->clear_object_index; - my $btaste4 = Film->retrieve('Bad Taste'); - isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste4), - "Clearing cache and retrieving again gives new object"; + # my bad taste is your bad taste + my $btaste = Film->retrieve('Bad Taste'); + my $btaste2 = Film->retrieve('Bad Taste'); + is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2), + "Retrieving twice gives ref to same object"; + + my ($btaste5) = Film->search(title=>'Bad Taste'); + is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste5), + "Searching also gives ref to same object"; + + $btaste2->remove_from_object_index; + my $btaste3 = Film->retrieve('Bad Taste'); + isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste3), + "Removing from object_index and retrieving again gives new object"; + + $btaste3->clear_object_index; + my $btaste4 = Film->retrieve('Bad Taste'); + isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste4), + "Clearing cache and retrieving again gives new object"; $btaste=Film->insert({ - Title => 'Bad Taste 2', - Director => 'Peter Jackson', - Rating => 'R', - NumExplodingSheep => 2, - }); - $btaste2 = Film->retrieve('Bad Taste 2'); - is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2), - "Creating and retrieving gives ref to same object"; + Title => 'Bad Taste 2', + Director => 'Peter Jackson', + Rating => 'R', + NumExplodingSheep => 2, + }); + $btaste2 = Film->retrieve('Bad Taste 2'); + is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2), + "Creating and retrieving gives ref to same object"; } diff --git a/t/cdbi/03-subclassing.t b/t/cdbi/03-subclassing.t index 1740de3..8527fea 100644 --- a/t/cdbi/03-subclassing.t +++ b/t/cdbi/03-subclassing.t @@ -22,7 +22,7 @@ INIT { @Film::Threat::ISA = qw/Film/; } ok(Film::Threat->db_Main->ping, 'subclass db_Main()'); is_deeply [ sort Film::Threat->columns ], [ sort Film->columns ], - 'has the same columns'; + 'has the same columns'; my $bt = Film->create_test_film; ok my $btaste = Film::Threat->retrieve('Bad Taste'), "subclass retrieve"; diff --git a/t/cdbi/04-lazy.t b/t/cdbi/04-lazy.t index 35a1219..60a6d3e 100644 --- a/t/cdbi/04-lazy.t +++ b/t/cdbi/04-lazy.t @@ -17,8 +17,8 @@ BEGIN { } INIT { - use lib 't/cdbi/testlib'; - use Lazy; + use lib 't/cdbi/testlib'; + use Lazy; } is_deeply [ Lazy->columns('Primary') ], [qw/this/], "Pri"; @@ -29,13 +29,13 @@ is_deeply [ sort Lazy->columns('vertical') ], [qw/oop opop/], "vertical"; is_deeply [ sort Lazy->columns('All') ], [qw/eep oop opop orp that this/], "All"; { - my @groups = Lazy->__grouper->groups_for(Lazy->find_column('this')); - is_deeply [ sort @groups ], [sort qw/things Essential Primary/], "this (@groups)"; + my @groups = Lazy->__grouper->groups_for(Lazy->find_column('this')); + is_deeply [ sort @groups ], [sort qw/things Essential Primary/], "this (@groups)"; } { - my @groups = Lazy->__grouper->groups_for(Lazy->find_column('that')); - is_deeply \@groups, [qw/things/], "that (@groups)"; + my @groups = Lazy->__grouper->groups_for(Lazy->find_column('that')); + is_deeply \@groups, [qw/things/], "that (@groups)"; } Lazy->create({ this => 1, that => 2, oop => 3, opop => 4, eep => 5 }); @@ -54,28 +54,28 @@ ok(!$obj->_attribute_exists('oop'), 'But still not oop'); ok(!$obj->_attribute_exists('that'), 'nor that'); { - Lazy->columns(All => qw/this that eep orp oop opop/); - ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary'); - ok !$obj->_attribute_exists('oop'), " Don't have oop"; - my $null = $obj->eep; - ok !$obj->_attribute_exists('oop'), - " Don't have oop - even after getting eep"; + Lazy->columns(All => qw/this that eep orp oop opop/); + ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary'); + ok !$obj->_attribute_exists('oop'), " Don't have oop"; + my $null = $obj->eep; + ok !$obj->_attribute_exists('oop'), + " Don't have oop - even after getting eep"; } # Test contructor breaking. eval { # Need a hashref - Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50); + Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50); }; ok($@, $@); eval { # False column - Lazy->create({ this => 10, that => 20, theother => 30 }); + Lazy->create({ this => 10, that => 20, theother => 30 }); }; ok($@, $@); eval { # Multiple false columns - Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 }); + Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 }); }; ok($@, $@); diff --git a/t/cdbi/06-hasa.t b/t/cdbi/06-hasa.t index cd27ab6..0fb3946 100644 --- a/t/cdbi/06-hasa.t +++ b/t/cdbi/06-hasa.t @@ -16,9 +16,9 @@ BEGIN { #local $SIG{__WARN__} = sub { }; INIT { - use lib 't/cdbi/testlib'; - use Film; - use Director; + use lib 't/cdbi/testlib'; + use Film; + use Director; } Film->create_test_film; @@ -28,14 +28,14 @@ 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' + Director->create( + { + Name => 'Peter Jackson', + Birthday => -300000000, + IsInsane => 1 + } + ), + 'create Director' ); $btaste = Film->retrieve('Bad Taste'); @@ -46,11 +46,11 @@ is($pj->id, 'Peter Jackson', ' ... and is the correct director'); # 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, - } + { + Name => 'Skippy Jackson', + Birthday => (-300000000 + 60), + IsInsane => 1, + } ); is($sj->id, 'Skippy Jackson', 'We have a new director'); @@ -61,71 +61,71 @@ $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" + $btaste->Director->Name, + 'Peter Jackson', + "Didnt interfere with each other" ); { # Ensure search can take an object - my @films = Film->search(Director => $pj); - is @films, 1, "1 Film directed by $pj"; - is $films[0]->id, "Bad Taste", "Bad Taste"; + my @films = Film->search(Director => $pj); + is @films, 1, "1 Film directed by $pj"; + is $films[0]->id, "Bad Taste", "Bad Taste"; } inheriting_hasa(); { - # Skippy directs a film and Peter helps! - $sj = Director->retrieve('Skippy Jackson'); - $pj = Director->retrieve('Peter Jackson'); + # Skippy directs a film and Peter helps! + $sj = Director->retrieve('Skippy Jackson'); + $pj = Director->retrieve('Peter Jackson'); - fail_with_bad_object($sj, $btaste); - taste_bad($sj, $pj); + fail_with_bad_object($sj, $btaste); + taste_bad($sj, $pj); } sub inheriting_hasa { - my $btaste = YA::Film->retrieve('Bad Taste'); - is(ref($btaste->Director), 'Director', 'inheriting has_a()'); - is(ref($btaste->CoDirector), 'Director', 'inheriting has_a()'); - is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly'); + my $btaste = YA::Film->retrieve('Bad Taste'); + is(ref($btaste->Director), 'Director', 'inheriting has_a()'); + is(ref($btaste->CoDirector), 'Director', 'inheriting has_a()'); + is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly'); } sub taste_bad { - my ($dir, $codir) = @_; - my $tastes_bad = YA::Film->create( - { - Title => 'Tastes Bad', - Director => $dir, - CoDirector => $codir, - Rating => 'R', - NumExplodingSheep => 23 - } - ); - is($tastes_bad->_Director_accessor, 'Skippy Jackson', 'Director_accessor'); - is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director'); - is($tastes_bad->CoDirector->Name, 'Peter Jackson', 'CoDirector'); - is( - $tastes_bad->_CoDirector_accessor, - 'Peter Jackson', - 'CoDirector_accessor' - ); + my ($dir, $codir) = @_; + my $tastes_bad = YA::Film->create( + { + Title => 'Tastes Bad', + Director => $dir, + CoDirector => $codir, + Rating => 'R', + NumExplodingSheep => 23 + } + ); + is($tastes_bad->_Director_accessor, 'Skippy Jackson', 'Director_accessor'); + is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director'); + is($tastes_bad->CoDirector->Name, 'Peter Jackson', 'CoDirector'); + is( + $tastes_bad->_CoDirector_accessor, + 'Peter Jackson', + 'CoDirector_accessor' + ); } sub fail_with_bad_object { - my ($dir, $codir) = @_; - eval { - YA::Film->create( - { - Title => 'Tastes Bad', - Director => $dir, - CoDirector => $codir, - Rating => 'R', - NumExplodingSheep => 23 - } - ); - }; - ok $@, $@; + my ($dir, $codir) = @_; + eval { + YA::Film->create( + { + Title => 'Tastes Bad', + Director => $dir, + CoDirector => $codir, + Rating => 'R', + NumExplodingSheep => 23 + } + ); + }; + ok $@, $@; } package Foo; @@ -135,8 +135,8 @@ __PACKAGE__->columns('All' => qw/ id fav /); # fav is a film __PACKAGE__->db_Main->do( qq{ CREATE TABLE foo ( - id INTEGER, - fav VARCHAR(255) + id INTEGER, + fav VARCHAR(255) ) }); @@ -148,8 +148,8 @@ __PACKAGE__->columns('All' => qw/ id fav /); # fav is a foo __PACKAGE__->db_Main->do( qq{ CREATE TABLE bar ( - id INTEGER, - fav INTEGER + id INTEGER, + fav INTEGER ) }); @@ -162,9 +162,9 @@ isa_ok($bar->fav, "Foo"); isa_ok($foo->fav, "Film"); { - my $foo; - Foo->add_trigger(after_create => sub { $foo = shift->fav }); - my $gwh = Foo->create({ id => 93, fav => 'Good Will Hunting' }); - isa_ok $foo, "Film", "Object in after_create trigger"; + my $foo; + Foo->add_trigger(after_create => sub { $foo = shift->fav }); + my $gwh = Foo->create({ id => 93, fav => 'Good Will Hunting' }); + isa_ok $foo, "Film", "Object in after_create trigger"; } diff --git a/t/cdbi/09-has_many.t b/t/cdbi/09-has_many.t index 0c1c845..96b50c0 100644 --- a/t/cdbi/09-has_many.t +++ b/t/cdbi/09-has_many.t @@ -25,14 +25,14 @@ Film->create_test_film; ok(my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste"); ok( - my $pvj = Actor->create( - { - Name => 'Peter Vere-Jones', - Film => undef, - Salary => '30_000', # For a voice! - } - ), - 'create Actor' + my $pvj = Actor->create( + { + Name => 'Peter Vere-Jones', + Film => undef, + Salary => '30_000', # For a voice! + } + ), + 'create Actor' ); is $pvj->Name, "Peter Vere-Jones", "PVJ name ok"; is $pvj->Film, undef, "No film"; @@ -40,14 +40,14 @@ ok $pvj->set_Film($btaste), "Set film"; $pvj->update; is $pvj->Film->id, $btaste->id, "Now film"; { - my @actors = $btaste->actors; - is(@actors, 1, "Bad taste has one actor"); - is($actors[0]->Name, $pvj->Name, " - the correct one"); + my @actors = $btaste->actors; + is(@actors, 1, "Bad taste has one actor"); + is($actors[0]->Name, $pvj->Name, " - the correct one"); } my %pj_data = ( - Name => 'Peter Jackson', - Salary => '0', # it's a labour of love + Name => 'Peter Jackson', + Salary => '0', # it's a labour of love ); eval { my $pj = Film->add_to_actors(\%pj_data) }; @@ -57,37 +57,37 @@ eval { my $pj = $btaste->add_to_actors(%pj_data) }; like $@, qr/needs/, "add_to_actors takes hash"; ok( - my $pj = $btaste->add_to_actors( - { - Name => 'Peter Jackson', - Salary => '0', # it's a labour of love - } - ), - 'add_to_actors' + my $pj = $btaste->add_to_actors( + { + Name => 'Peter Jackson', + Salary => '0', # it's a labour of love + } + ), + 'add_to_actors' ); is $pj->Name, "Peter Jackson", "PJ ok"; is $pvj->Name, "Peter Vere-Jones", "PVJ still ok"; { - my @actors = $btaste->actors; - is @actors, 2, " - so now we have 2"; - is $actors[0]->Name, $pj->Name, "PJ first"; - is $actors[1]->Name, $pvj->Name, "PVJ first"; + my @actors = $btaste->actors; + is @actors, 2, " - so now we have 2"; + is $actors[0]->Name, $pj->Name, "PJ first"; + is $actors[1]->Name, $pvj->Name, "PVJ first"; } eval { - my @actors = $btaste->actors(Name => $pj->Name); - is @actors, 1, "One actor from restricted (sorted) has_many"; - is $actors[0]->Name, $pj->Name, "It's PJ"; + my @actors = $btaste->actors(Name => $pj->Name); + is @actors, 1, "One actor from restricted (sorted) has_many"; + is $actors[0]->Name, $pj->Name, "It's PJ"; }; is $@, '', "No errors"; my $as = Actor->create( - { - Name => 'Arnold Schwarzenegger', - Film => 'Terminator 2', - Salary => '15_000_000' - } + { + Name => 'Arnold Schwarzenegger', + Film => 'Terminator 2', + Salary => '15_000_000' + } ); eval { $btaste->actors($pj, $pvj, $as) }; diff --git a/t/cdbi/11-triggers.t b/t/cdbi/11-triggers.t index efab875..918403a 100644 --- a/t/cdbi/11-triggers.t +++ b/t/cdbi/11-triggers.t @@ -18,8 +18,8 @@ sub create_trigger2 { ::ok(1, "Running create trigger 2"); } sub delete_trigger { ::ok(1, "Deleting " . shift->Title) } sub pre_up_trigger { - $_[0]->_attribute_set(numexplodingsheep => 1); - ::ok(1, "Running pre-update trigger"); + $_[0]->_attribute_set(numexplodingsheep => 1); + ::ok(1, "Running pre-update trigger"); } sub pst_up_trigger { ::ok(1, "Running post-update trigger"); } @@ -32,15 +32,15 @@ Film->add_trigger(before_update => \&pre_up_trigger); Film->add_trigger(after_update => \&pst_up_trigger); ok( - my $ver = Film->create({ - title => 'La Double Vie De Veronique', - director => 'Kryzstof Kieslowski', + my $ver = Film->create({ + title => 'La Double Vie De Veronique', + director => 'Kryzstof Kieslowski', - # rating => '15', - numexplodingsheep => 0, - } - ), - "Create Veronique" + # rating => '15', + numexplodingsheep => 0, + } + ), + "Create Veronique" ); is $ver->Rating, 15, "Default rating"; @@ -48,19 +48,19 @@ is $ver->NumExplodingSheep, 0, "Original sheep count"; ok $ver->Rating('12') && $ver->update, "Change the rating"; is $ver->NumExplodingSheep, 1, "Updated object's sheep count"; is + ( - $ver->db_Main->selectall_arrayref( - 'SELECT numexplodingsheep FROM ' - . $ver->table - . ' WHERE ' - . $ver->primary_column . ' = ' - . $ver->db_Main->quote($ver->id)) + $ver->db_Main->selectall_arrayref( + 'SELECT numexplodingsheep FROM ' + . $ver->table + . ' WHERE ' + . $ver->primary_column . ' = ' + . $ver->db_Main->quote($ver->id)) )->[0]->[0], 1, "Updated database's sheep count"; ok $ver->delete, "Delete"; { - Film->add_trigger(before_create => sub { - my $self = shift; - ok !$self->_attribute_exists('title'), "PK doesn't auto-vivify"; - }); - Film->create({director => "Me"}); + Film->add_trigger(before_create => sub { + my $self = shift; + ok !$self->_attribute_exists('title'), "PK doesn't auto-vivify"; + }); + Film->create({director => "Me"}); } diff --git a/t/cdbi/12-filter.t b/t/cdbi/12-filter.t index e82b579..bdc9687 100644 --- a/t/cdbi/12-filter.t +++ b/t/cdbi/12-filter.t @@ -22,76 +22,76 @@ my $film = Film->create({ Title => 'MY Film' }); my $film2 = Film->create({ Title => 'Another Film' }); my @act = ( - Actor->create( - { - name => 'Actor 1', - film => $film, - salary => 10, - } - ), - Actor->create( - { - name => 'Actor 2', - film => $film, - salary => 20, - } - ), - Actor->create( - { - name => 'Actor 3', - film => $film, - salary => 30, - } - ), - Actor->create( - { - name => 'Actor 4', - film => $film2, - salary => 50, - } - ), + Actor->create( + { + name => 'Actor 1', + film => $film, + salary => 10, + } + ), + Actor->create( + { + name => 'Actor 2', + film => $film, + salary => 20, + } + ), + Actor->create( + { + name => 'Actor 3', + film => $film, + salary => 30, + } + ), + Actor->create( + { + name => 'Actor 4', + film => $film2, + salary => 50, + } + ), ); eval { - my @actors = $film->actors(name => 'Actor 1'); - is @actors, 1, "Got one actor from restricted has_many"; - is $actors[0]->name, "Actor 1", "Correct name"; + my @actors = $film->actors(name => 'Actor 1'); + is @actors, 1, "Got one actor from restricted has_many"; + is $actors[0]->name, "Actor 1", "Correct name"; }; is $@, '', "No errors"; { - my @actors = Actor->double_search("Actor 1", 10); - is @actors, 1, "Got one actor"; - is $actors[0]->name, "Actor 1", "Correct name"; + my @actors = Actor->double_search("Actor 1", 10); + is @actors, 1, "Got one actor"; + is $actors[0]->name, "Actor 1", "Correct name"; } { - ok my @actors = Actor->salary_between(0, 100), "Range 0 - 100"; - is @actors, 4, "Got all"; + ok my @actors = Actor->salary_between(0, 100), "Range 0 - 100"; + is @actors, 4, "Got all"; } { - my @actors = Actor->salary_between(100, 200); - is @actors, 0, "None in Range 100 - 200"; + my @actors = Actor->salary_between(100, 200); + is @actors, 0, "None in Range 100 - 200"; } { - ok my @actors = Actor->salary_between(0, 10), "Range 0 - 10"; - is @actors, 1, "Got 1"; - is $actors[0]->name, $act[0]->name, "Actor 1"; + ok my @actors = Actor->salary_between(0, 10), "Range 0 - 10"; + is @actors, 1, "Got 1"; + is $actors[0]->name, $act[0]->name, "Actor 1"; } { - ok my @actors = Actor->salary_between(20, 30), "Range 20 - 20"; - @actors = sort { $a->salary <=> $b->salary } @actors; - is @actors, 2, "Got 2"; - is $actors[0]->name, $act[1]->name, "Actor 2"; - is $actors[1]->name, $act[2]->name, "and Actor 3"; + ok my @actors = Actor->salary_between(20, 30), "Range 20 - 20"; + @actors = sort { $a->salary <=> $b->salary } @actors; + is @actors, 2, "Got 2"; + is $actors[0]->name, $act[1]->name, "Actor 2"; + is $actors[1]->name, $act[2]->name, "and Actor 3"; } { - ok my @actors = Actor->search(Film => $film), "Search by object"; - is @actors, 3, "3 actors in film 1"; + ok my @actors = Actor->search(Film => $film), "Search by object"; + is @actors, 3, "3 actors in film 1"; } #---------------------------------------------------------------------- @@ -101,29 +101,29 @@ is $@, '', "No errors"; my $it_class = 'DBIx::Class::ResultSet'; sub test_normal_iterator { - my $it = $film->actors; - isa_ok $it, $it_class; - is $it->count, 3, " - with 3 elements"; - my $i = 0; - while (my $film = $it->next) { - is $film->name, $act[ $i++ ]->name, "Get $i"; - } - ok !$it->next, "No more"; - is $it->first->name, $act[0]->name, "Get first"; + my $it = $film->actors; + isa_ok $it, $it_class; + is $it->count, 3, " - with 3 elements"; + my $i = 0; + while (my $film = $it->next) { + is $film->name, $act[ $i++ ]->name, "Get $i"; + } + ok !$it->next, "No more"; + is $it->first->name, $act[0]->name, "Get first"; } test_normal_iterator; { - Film->has_many(actor_ids => [ Actor => 'id' ]); - my $it = $film->actor_ids; - isa_ok $it, $it_class; - is $it->count, 3, " - with 3 elements"; - my $i = 0; - while (my $film_id = $it->next) { - is $film_id, $act[ $i++ ]->id, "Get id $i"; - } - ok !$it->next, "No more"; - is $it->first, $act[0]->id, "Get first"; + Film->has_many(actor_ids => [ Actor => 'id' ]); + my $it = $film->actor_ids; + isa_ok $it, $it_class; + is $it->count, 3, " - with 3 elements"; + my $i = 0; + while (my $film_id = $it->next) { + is $film_id, $act[ $i++ ]->id, "Get id $i"; + } + ok !$it->next, "No more"; + is $it->first, $act[0]->id, "Get first"; } # make sure nothing gets clobbered; @@ -134,22 +134,22 @@ SKIP: { { - my @acts = $film->actors->slice(1, 2); - is @acts, 2, "Slice gives 2 actor"; - is $acts[0]->name, "Actor 2", "Actor 2"; - is $acts[1]->name, "Actor 3", "and actor 3"; + my @acts = $film->actors->slice(1, 2); + is @acts, 2, "Slice gives 2 actor"; + is $acts[0]->name, "Actor 2", "Actor 2"; + is $acts[1]->name, "Actor 3", "and actor 3"; } { - my @acts = $film->actors->slice(1); - is @acts, 1, "Slice of 1 actor"; - is $acts[0]->name, "Actor 2", "Actor 2"; + my @acts = $film->actors->slice(1); + is @acts, 1, "Slice of 1 actor"; + is $acts[0]->name, "Actor 2", "Actor 2"; } { - my @acts = $film->actors->slice(2, 8); - is @acts, 1, "Slice off the end"; - is $acts[0]->name, "Actor 3", "Gets last actor only"; + my @acts = $film->actors->slice(2, 8); + is @acts, 1, "Slice off the end"; + is $acts[0]->name, "Actor 3", "Gets last actor only"; } package Class::DBI::My::Iterator; @@ -167,15 +167,15 @@ Actor->iterator_class('Class::DBI::My::Iterator'); delete $film->{related_resultsets}; { - my @acts = $film->actors->slice(1, 2); - is @acts, 2, "Slice gives 2 results"; - ok eq_set(\@acts, [qw/fred barney/]), "Fred and Barney"; + my @acts = $film->actors->slice(1, 2); + is @acts, 2, "Slice gives 2 results"; + ok eq_set(\@acts, [qw/fred barney/]), "Fred and Barney"; - ok $film->actors->delete_all, "Can delete via iterator"; - is $film->actors, 0, "no actors left"; + ok $film->actors->delete_all, "Can delete via iterator"; + is $film->actors, 0, "no actors left"; - eval { $film->actors->delete_all }; - is $@, '', "Deleting again does no harm"; + eval { $film->actors->delete_all }; + is $@, '', "Deleting again does no harm"; } } # end SKIP block diff --git a/t/cdbi/14-might_have.t b/t/cdbi/14-might_have.t index b309edc..a8c163f 100644 --- a/t/cdbi/14-might_have.t +++ b/t/cdbi/14-might_have.t @@ -26,45 +26,45 @@ Film->might_have(info => Blurb => qw/blurb/); Film->create_test_film; { - ok my $bt = Film->retrieve('Bad Taste'), "Get Film"; - isa_ok $bt, "Film"; - is $bt->info, undef, "No blurb yet"; - # bug where we couldn't write a class with a might_have that didn't_have - $bt->rating(16); - eval { $bt->update }; - is $@, '', "No problems updating when don't have"; - is $bt->rating, 16, "Updated OK"; + ok my $bt = Film->retrieve('Bad Taste'), "Get Film"; + isa_ok $bt, "Film"; + is $bt->info, undef, "No blurb yet"; + # bug where we couldn't write a class with a might_have that didn't_have + $bt->rating(16); + eval { $bt->update }; + is $@, '', "No problems updating when don't have"; + is $bt->rating, 16, "Updated OK"; - is $bt->blurb, undef, "Bad taste has no blurb"; - $bt->blurb("Wibble bar"); - $bt->update; - is $bt->blurb, "Wibble bar", "And we can write the info"; + is $bt->blurb, undef, "Bad taste has no blurb"; + $bt->blurb("Wibble bar"); + $bt->update; + is $bt->blurb, "Wibble bar", "And we can write the info"; } { - my $bt = Film->retrieve('Bad Taste'); - my $info = $bt->info; - isa_ok $info, 'Blurb'; + my $bt = Film->retrieve('Bad Taste'); + my $info = $bt->info; + isa_ok $info, 'Blurb'; - is $bt->blurb, $info->blurb, "Blurb is the same as fetching the long way"; - ok $bt->blurb("New blurb"), "We can set the blurb"; - $bt->update; - is $bt->blurb, $info->blurb, "Blurb has been set"; + is $bt->blurb, $info->blurb, "Blurb is the same as fetching the long way"; + ok $bt->blurb("New blurb"), "We can set the blurb"; + $bt->update; + is $bt->blurb, $info->blurb, "Blurb has been set"; - $bt->rating(18); - eval { $bt->update }; - is $@, '', "No problems updating when do have"; - is $bt->rating, 18, "Updated OK"; + $bt->rating(18); + eval { $bt->update }; + is $@, '', "No problems updating when do have"; + is $bt->rating, 18, "Updated OK"; - # cascade delete? - { - my $blurb = Blurb->retrieve('Bad Taste'); - isa_ok $blurb => "Blurb"; - $bt->delete; - $blurb = Blurb->retrieve('Bad Taste'); - is $blurb, undef, "Blurb has gone"; - } - + # cascade delete? + { + my $blurb = Blurb->retrieve('Bad Taste'); + isa_ok $blurb => "Blurb"; + $bt->delete; + $blurb = Blurb->retrieve('Bad Taste'); + is $blurb, undef, "Blurb has gone"; + } + } { diff --git a/t/cdbi/15-accessor.t b/t/cdbi/15-accessor.t index 3419cf0..b0b684c 100644 --- a/t/cdbi/15-accessor.t +++ b/t/cdbi/15-accessor.t @@ -83,7 +83,7 @@ eval { my $data = { %$data }; $data->{NumExplodingSheep} = 1; ok my $bt = Film->find_or_create($data), - "find_or_create Modified accessor - find with column name"; + "find_or_create Modified accessor - find with column name"; isa_ok $bt, "Film"; is $bt->sheep, 1, 'sheep bursting violently'; }; @@ -93,7 +93,7 @@ eval { my $data = { %$data }; $data->{sheep} = 1; ok my $bt = Film->find_or_create($data), - "find_or_create Modified accessor - find with accessor"; + "find_or_create Modified accessor - find with accessor"; isa_ok $bt, "Film"; is $bt->sheep, 1, 'sheep bursting violently'; }; @@ -104,7 +104,7 @@ eval { my $data = { %$data }; $data->{NumExplodingSheep} = 3; ok my $bt = Film->find_or_create($data), - "find_or_create Modified accessor - create with column name"; + "find_or_create Modified accessor - create with column name"; isa_ok $bt, "Film"; is $bt->sheep, 3, 'sheep bursting violently'; }; @@ -114,7 +114,7 @@ eval { my $data = { %$data }; $data->{sheep} = 4; ok my $bt = Film->find_or_create($data), - "find_or_create Modified accessor - create with accessor"; + "find_or_create Modified accessor - create with accessor"; isa_ok $bt, "Film"; is $bt->sheep, 4, 'sheep bursting violently'; }; diff --git a/t/cdbi/18-has_a.t b/t/cdbi/18-has_a.t index e49c4d8..9732b65 100644 --- a/t/cdbi/18-has_a.t +++ b/t/cdbi/18-has_a.t @@ -24,217 +24,217 @@ 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' + 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"; + 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, - }); + 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"; + 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; + # 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"; + 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"; + 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" + $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'); + 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' - ); + $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'; + { + + 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: $@"; + eval { Film->has_a(driector => "Director") }; + like $@, qr/driector/, "Sensible error from has_a with incorrect column: $@"; } diff --git a/t/cdbi/19-set_sql.t b/t/cdbi/19-set_sql.t index eb464a3..ebd571d 100644 --- a/t/cdbi/19-set_sql.t +++ b/t/cdbi/19-set_sql.t @@ -16,14 +16,14 @@ use Film; use Actor; { # Check __ESSENTIAL__ expansion (RT#13038) - my @cols = Film->columns('Essential'); - is_deeply \@cols, ['title'], "1 Column in essential"; - is +Film->transform_sql('__ESSENTIAL__'), 'title', '__ESSENTIAL__ expansion'; - - # This provides a more interesting test - Film->columns(Essential => qw(title rating)); - is +Film->transform_sql('__ESSENTIAL__'), 'title, rating', - 'multi-col __ESSENTIAL__ expansion'; + my @cols = Film->columns('Essential'); + is_deeply \@cols, ['title'], "1 Column in essential"; + is +Film->transform_sql('__ESSENTIAL__'), 'title', '__ESSENTIAL__ expansion'; + + # This provides a more interesting test + Film->columns(Essential => qw(title rating)); + is +Film->transform_sql('__ESSENTIAL__'), 'title, rating', + 'multi-col __ESSENTIAL__ expansion'; } my $f1 = Film->create({ title => 'A', director => 'AA', rating => 'PG' }); @@ -33,43 +33,43 @@ my $f4 = Film->create({ title => 'D', director => 'BA', rating => '18' }); my $f5 = Film->create({ title => 'E', director => 'AA', rating => '18' }); Film->set_sql( - pgs => qq{ - SELECT __ESSENTIAL__ - FROM __TABLE__ - WHERE __TABLE__.rating = 'PG' - ORDER BY title DESC + pgs => qq{ + SELECT __ESSENTIAL__ + FROM __TABLE__ + WHERE __TABLE__.rating = 'PG' + ORDER BY title DESC } ); { - (my $sth = Film->sql_pgs())->execute; - my @pgs = Film->sth_to_objects($sth); - is @pgs, 2, "Execute our own SQL"; - is $pgs[0]->id, $f2->id, "get F2"; - is $pgs[1]->id, $f1->id, "and F1"; + (my $sth = Film->sql_pgs())->execute; + my @pgs = Film->sth_to_objects($sth); + is @pgs, 2, "Execute our own SQL"; + is $pgs[0]->id, $f2->id, "get F2"; + is $pgs[1]->id, $f1->id, "and F1"; } { - my @pgs = Film->search_pgs; - is @pgs, 2, "SQL creates search() method"; - is $pgs[0]->id, $f2->id, "get F2"; - is $pgs[1]->id, $f1->id, "and F1"; + my @pgs = Film->search_pgs; + is @pgs, 2, "SQL creates search() method"; + is $pgs[0]->id, $f2->id, "get F2"; + is $pgs[1]->id, $f1->id, "and F1"; }; Film->set_sql( - rating => qq{ - SELECT __ESSENTIAL__ - FROM __TABLE__ - WHERE rating = ? - ORDER BY title DESC + rating => qq{ + SELECT __ESSENTIAL__ + FROM __TABLE__ + WHERE rating = ? + ORDER BY title DESC } ); { - my @pgs = Film->search_rating('18'); - is @pgs, 2, "Can pass parameters to created search()"; - is $pgs[0]->id, $f5->id, "F5"; - is $pgs[1]->id, $f4->id, "and F4"; + my @pgs = Film->search_rating('18'); + is @pgs, 2, "Can pass parameters to created search()"; + is $pgs[0]->id, $f5->id, "F5"; + is $pgs[1]->id, $f4->id, "and F4"; }; { @@ -89,44 +89,44 @@ Film->set_sql( { - Actor->has_a(film => "Film"); - Film->set_sql( - namerate => qq{ - SELECT __ESSENTIAL(f)__ - FROM __TABLE(=f)__, __TABLE(Actor=a)__ - WHERE __JOIN(a f)__ - AND a.name LIKE ? - AND f.rating = ? - ORDER BY title - } - ); - - my $a1 = Actor->create({ name => "A1", film => $f1 }); - my $a2 = Actor->create({ name => "A2", film => $f2 }); - my $a3 = Actor->create({ name => "B1", film => $f1 }); - - my @apg = Film->search_namerate("A_", "PG"); - is @apg, 2, "2 Films with A* that are PG"; - is $apg[0]->title, "A", "A"; - is $apg[1]->title, "B", "and B"; + Actor->has_a(film => "Film"); + Film->set_sql( + namerate => qq{ + SELECT __ESSENTIAL(f)__ + FROM __TABLE(=f)__, __TABLE(Actor=a)__ + WHERE __JOIN(a f)__ + AND a.name LIKE ? + AND f.rating = ? + ORDER BY title + } + ); + + my $a1 = Actor->create({ name => "A1", film => $f1 }); + my $a2 = Actor->create({ name => "A2", film => $f2 }); + my $a3 = Actor->create({ name => "B1", film => $f1 }); + + my @apg = Film->search_namerate("A_", "PG"); + is @apg, 2, "2 Films with A* that are PG"; + is $apg[0]->title, "A", "A"; + is $apg[1]->title, "B", "and B"; } { # join in reverse - Actor->has_a(film => "Film"); - Film->set_sql( - ratename => qq{ - SELECT __ESSENTIAL(f)__ - FROM __TABLE(=f)__, __TABLE(Actor=a)__ - WHERE __JOIN(f a)__ - AND f.rating = ? - AND a.name LIKE ? - ORDER BY title - } - ); - - my @apg = Film->search_ratename(PG => "A_"); - is @apg, 2, "2 Films with A* that are PG"; - is $apg[0]->title, "A", "A"; - is $apg[1]->title, "B", "and B"; + Actor->has_a(film => "Film"); + Film->set_sql( + ratename => qq{ + SELECT __ESSENTIAL(f)__ + FROM __TABLE(=f)__, __TABLE(Actor=a)__ + WHERE __JOIN(f a)__ + AND f.rating = ? + AND a.name LIKE ? + ORDER BY title + } + ); + + my @apg = Film->search_ratename(PG => "A_"); + is @apg, 2, "2 Films with A* that are PG"; + is $apg[0]->title, "A", "A"; + is $apg[1]->title, "B", "and B"; } diff --git a/t/cdbi/21-iterator.t b/t/cdbi/21-iterator.t index c5717c7..6be3a5c 100644 --- a/t/cdbi/21-iterator.t +++ b/t/cdbi/21-iterator.t @@ -17,70 +17,70 @@ use Film; my $it_class = "DBIx::Class::ResultSet"; my @film = ( - Film->create({ Title => 'Film 1' }), - Film->create({ Title => 'Film 2' }), - Film->create({ Title => 'Film 3' }), - Film->create({ Title => 'Film 4' }), - Film->create({ Title => 'Film 5' }), - Film->create({ Title => 'Film 6' }), + Film->create({ Title => 'Film 1' }), + Film->create({ Title => 'Film 2' }), + Film->create({ Title => 'Film 3' }), + Film->create({ Title => 'Film 4' }), + Film->create({ Title => 'Film 5' }), + Film->create({ Title => 'Film 6' }), ); { - my $it1 = Film->retrieve_all; - isa_ok $it1, $it_class; + my $it1 = Film->retrieve_all; + isa_ok $it1, $it_class; - my $it2 = Film->retrieve_all; - isa_ok $it2, $it_class; + my $it2 = Film->retrieve_all; + isa_ok $it2, $it_class; - while (my $from1 = $it1->next) { - my $from2 = $it2->next; - is $from1->id, $from2->id, "Both iterators get $from1"; - } + while (my $from1 = $it1->next) { + my $from2 = $it2->next; + is $from1->id, $from2->id, "Both iterators get $from1"; + } } { - my $it = Film->retrieve_all; - is $it->first->title, "Film 1", "Film 1 first"; - is $it->next->title, "Film 2", "Film 2 next"; - is $it->first->title, "Film 1", "First goes back to 1"; - is $it->next->title, "Film 2", "With 2 still next"; - $it->reset; - is $it->next->title, "Film 1", "Reset brings us to film 1 again"; - is $it->next->title, "Film 2", "And 2 is still next"; + my $it = Film->retrieve_all; + is $it->first->title, "Film 1", "Film 1 first"; + is $it->next->title, "Film 2", "Film 2 next"; + is $it->first->title, "Film 1", "First goes back to 1"; + is $it->next->title, "Film 2", "With 2 still next"; + $it->reset; + is $it->next->title, "Film 1", "Reset brings us to film 1 again"; + is $it->next->title, "Film 2", "And 2 is still next"; } { - my $it = Film->retrieve_all; - my @slice = $it->slice(2,4); - is @slice, 3, "correct slice size (array)"; - is $slice[0]->title, "Film 3", "Film 3 first"; - is $slice[2]->title, "Film 5", "Film 5 last"; + my $it = Film->retrieve_all; + my @slice = $it->slice(2,4); + is @slice, 3, "correct slice size (array)"; + is $slice[0]->title, "Film 3", "Film 3 first"; + is $slice[2]->title, "Film 5", "Film 5 last"; } { - my $it = Film->retrieve_all; - my $slice = $it->slice(2,4); - isa_ok $slice, $it_class, "slice as iterator"; - is $slice->count, 3,"correct slice size (array)"; - is $slice->first->title, "Film 3", "Film 3 first"; - is $slice->next->title, "Film 4", "Film 4 next"; - is $slice->first->title, "Film 3", "First goes back to 3"; - is $slice->next->title, "Film 4", "With 4 still next"; - $slice->reset; - is $slice->next->title, "Film 3", "Reset brings us to film 3 again"; - is $slice->next->title, "Film 4", "And 4 is still next"; + my $it = Film->retrieve_all; + my $slice = $it->slice(2,4); + isa_ok $slice, $it_class, "slice as iterator"; + is $slice->count, 3,"correct slice size (array)"; + is $slice->first->title, "Film 3", "Film 3 first"; + is $slice->next->title, "Film 4", "Film 4 next"; + is $slice->first->title, "Film 3", "First goes back to 3"; + is $slice->next->title, "Film 4", "With 4 still next"; + $slice->reset; + is $slice->next->title, "Film 3", "Reset brings us to film 3 again"; + is $slice->next->title, "Film 4", "And 4 is still next"; - # check if the original iterator still works - is $it->count, 6, "back to the original iterator, is of right size"; - is $it->first->title, "Film 1", "Film 1 first"; - is $it->next->title, "Film 2", "Film 2 next"; - is $it->first->title, "Film 1", "First goes back to 1"; - is $it->next->title, "Film 2", "With 2 still next"; - is $it->next->title, "Film 3", "Film 3 is still in original Iterator"; - $it->reset; - is $it->next->title, "Film 1", "Reset brings us to film 1 again"; - is $it->next->title, "Film 2", "And 2 is still next"; + # check if the original iterator still works + is $it->count, 6, "back to the original iterator, is of right size"; + is $it->first->title, "Film 1", "Film 1 first"; + is $it->next->title, "Film 2", "Film 2 next"; + is $it->first->title, "Film 1", "First goes back to 1"; + is $it->next->title, "Film 2", "With 2 still next"; + is $it->next->title, "Film 3", "Film 3 is still in original Iterator"; + $it->reset; + is $it->next->title, "Film 1", "Reset brings us to film 1 again"; + is $it->next->title, "Film 2", "And 2 is still next"; } { diff --git a/t/cdbi/26-mutator.t b/t/cdbi/26-mutator.t index 5a1cf8f..7ba95bd 100644 --- a/t/cdbi/26-mutator.t +++ b/t/cdbi/26-mutator.t @@ -8,40 +8,40 @@ BEGIN { } BEGIN { - eval "use DBD::SQLite"; - plan $@ - ? (skip_all => 'needs DBD::SQLite for testing') - : (tests => 6); + eval "use DBD::SQLite"; + plan $@ + ? (skip_all => 'needs DBD::SQLite for testing') + : (tests => 6); } use lib 't/cdbi/testlib'; require Film; sub Film::accessor_name_for { - my ($class, $col) = @_; - return "sheep" if lc $col eq "numexplodingsheep"; - return $col; + my ($class, $col) = @_; + return "sheep" if lc $col eq "numexplodingsheep"; + return $col; } my $data = { - Title => 'Bad Taste', - Director => 'Peter Jackson', - Rating => 'R', + Title => 'Bad Taste', + Director => 'Peter Jackson', + Rating => 'R', }; my $bt; eval { - my $data = $data; - $data->{sheep} = 1; - ok $bt = Film->insert($data), "Modified accessor - with + my $data = $data; + $data->{sheep} = 1; + ok $bt = Film->insert($data), "Modified accessor - with accessor"; - isa_ok $bt, "Film"; + isa_ok $bt, "Film"; }; is $@, '', "No errors"; eval { - ok $bt->sheep(2), 'Modified accessor, set'; - ok $bt->update, 'Update'; + ok $bt->sheep(2), 'Modified accessor, set'; + ok $bt->update, 'Update'; }; is $@, '', "No errors"; diff --git a/t/cdbi/30-pager.t b/t/cdbi/30-pager.t index 2a90bfd..f7cb867 100644 --- a/t/cdbi/30-pager.t +++ b/t/cdbi/30-pager.t @@ -15,11 +15,11 @@ use lib 't/cdbi/testlib'; use Film; my @film = ( - Film->create({ Title => 'Film 1' }), - Film->create({ Title => 'Film 2' }), - Film->create({ Title => 'Film 3' }), - Film->create({ Title => 'Film 4' }), - Film->create({ Title => 'Film 5' }), + Film->create({ Title => 'Film 1' }), + Film->create({ Title => 'Film 2' }), + Film->create({ Title => 'Film 3' }), + Film->create({ Title => 'Film 4' }), + Film->create({ Title => 'Film 5' }), ); # first page diff --git a/t/cdbi/98-failure.t b/t/cdbi/98-failure.t index 9217342..0f584b1 100644 --- a/t/cdbi/98-failure.t +++ b/t/cdbi/98-failure.t @@ -21,42 +21,42 @@ use Film; Film->create_test_film; { - my $btaste = Film->retrieve('Bad Taste'); - isa_ok $btaste, 'Film', "We have Bad Taste"; - { - no warnings 'redefine'; - local *DBIx::ContextualFetch::st::execute = sub { die "Database died" }; - eval { $btaste->delete }; - ::like $@, qr/Database died/s, "We failed"; - } - my $still = Film->retrieve('Bad Taste'); - isa_ok $btaste, 'Film', "We still have Bad Taste"; + my $btaste = Film->retrieve('Bad Taste'); + isa_ok $btaste, 'Film', "We have Bad Taste"; + { + no warnings 'redefine'; + local *DBIx::ContextualFetch::st::execute = sub { die "Database died" }; + eval { $btaste->delete }; + ::like $@, qr/Database died/s, "We failed"; + } + my $still = Film->retrieve('Bad Taste'); + isa_ok $btaste, 'Film', "We still have Bad Taste"; } { - my $btaste = Film->retrieve('Bad Taste'); - isa_ok $btaste, 'Film', "We have Bad Taste"; - $btaste->numexplodingsheep(10); - { - no warnings 'redefine'; - local *DBIx::ContextualFetch::st::execute = sub { die "Database died" }; - eval { $btaste->update }; - ::like $@, qr/Database died/s, "We failed"; - } - $btaste->discard_changes; - my $still = Film->retrieve('Bad Taste'); - isa_ok $btaste, 'Film', "We still have Bad Taste"; - is $btaste->numexplodingsheep, 1, "with 1 sheep"; + my $btaste = Film->retrieve('Bad Taste'); + isa_ok $btaste, 'Film', "We have Bad Taste"; + $btaste->numexplodingsheep(10); + { + no warnings 'redefine'; + local *DBIx::ContextualFetch::st::execute = sub { die "Database died" }; + eval { $btaste->update }; + ::like $@, qr/Database died/s, "We failed"; + } + $btaste->discard_changes; + my $still = Film->retrieve('Bad Taste'); + isa_ok $btaste, 'Film', "We still have Bad Taste"; + is $btaste->numexplodingsheep, 1, "with 1 sheep"; } if (0) { - my $sheep = Film->maximum_value_of('numexplodingsheep'); - is $sheep, 1, "1 exploding sheep"; - { - local *DBIx::ContextualFetch::st::execute = sub { die "Database died" }; - my $sheep = eval { Film->maximum_value_of('numexplodingsheep') }; - ::like $@, qr/select.*Database died/s, - "Handle database death in single value select"; - } + my $sheep = Film->maximum_value_of('numexplodingsheep'); + is $sheep, 1, "1 exploding sheep"; + { + local *DBIx::ContextualFetch::st::execute = sub { die "Database died" }; + my $sheep = eval { Film->maximum_value_of('numexplodingsheep') }; + ::like $@, qr/select.*Database died/s, + "Handle database death in single value select"; + } } diff --git a/t/cdbi/abstract/search_where.t b/t/cdbi/abstract/search_where.t index 52595e2..a8a2445 100644 --- a/t/cdbi/abstract/search_where.t +++ b/t/cdbi/abstract/search_where.t @@ -14,8 +14,8 @@ BEGIN { } INIT { - use lib 't/cdbi/testlib'; - use Film; + use lib 't/cdbi/testlib'; + use Film; } diff --git a/t/cdbi/testlib/Actor.pm b/t/cdbi/testlib/Actor.pm index 2944390..9bbda39 100644 --- a/t/cdbi/testlib/Actor.pm +++ b/t/cdbi/testlib/Actor.pm @@ -16,12 +16,12 @@ __PACKAGE__->add_constructor(salary_between => 'salary >= ? AND salary <= ?'); sub mutator_name_for { "set_$_[1]" } sub create_sql { - return qq{ - id INTEGER PRIMARY KEY, - name CHAR(40), - film VARCHAR(255), - salary INT - } + return qq{ + id INTEGER PRIMARY KEY, + name CHAR(40), + film VARCHAR(255), + salary INT + } } 1; diff --git a/t/cdbi/testlib/ActorAlias.pm b/t/cdbi/testlib/ActorAlias.pm index 9e4ebe4..30004b1 100644 --- a/t/cdbi/testlib/ActorAlias.pm +++ b/t/cdbi/testlib/ActorAlias.pm @@ -14,11 +14,11 @@ __PACKAGE__->has_a( actor => 'Actor' ); __PACKAGE__->has_a( alias => 'Actor' ); sub create_sql { - return qq{ - id INTEGER PRIMARY KEY, - actor INTEGER, - alias INTEGER - } + return qq{ + id INTEGER PRIMARY KEY, + actor INTEGER, + alias INTEGER + } } 1; diff --git a/t/cdbi/testlib/Blurb.pm b/t/cdbi/testlib/Blurb.pm index 7c6dfdb..22eb2eb 100644 --- a/t/cdbi/testlib/Blurb.pm +++ b/t/cdbi/testlib/Blurb.pm @@ -9,9 +9,9 @@ __PACKAGE__->columns('Primary', 'Title'); __PACKAGE__->columns('Blurb', qw/ blurb/); sub create_sql { - return qq{ - title VARCHAR(255) PRIMARY KEY, - blurb VARCHAR(255) NOT NULL + return qq{ + title VARCHAR(255) PRIMARY KEY, + blurb VARCHAR(255) NOT NULL } } diff --git a/t/cdbi/testlib/Director.pm b/t/cdbi/testlib/Director.pm index a9dd199..549aebb 100644 --- a/t/cdbi/testlib/Director.pm +++ b/t/cdbi/testlib/Director.pm @@ -8,11 +8,11 @@ __PACKAGE__->set_table('Directors'); __PACKAGE__->columns('All' => qw/ Name Birthday IsInsane /); sub create_sql { - return qq{ - name VARCHAR(80), - birthday INTEGER, - isinsane INTEGER - }; + return qq{ + name VARCHAR(80), + birthday INTEGER, + isinsane INTEGER + }; } 1; diff --git a/t/cdbi/testlib/Film.pm b/t/cdbi/testlib/Film.pm index b1f50ac..3d6c457 100644 --- a/t/cdbi/testlib/Film.pm +++ b/t/cdbi/testlib/Film.pm @@ -11,23 +11,23 @@ __PACKAGE__->columns('Directors', qw( Director CoDirector )); __PACKAGE__->columns('Other', qw( Rating NumExplodingSheep HasVomit )); sub create_sql { - return qq{ - title VARCHAR(255), - director VARCHAR(80), - codirector VARCHAR(80), - rating CHAR(5), - numexplodingsheep INTEGER, - hasvomit CHAR(1) + return qq{ + title VARCHAR(255), + director VARCHAR(80), + codirector VARCHAR(80), + rating CHAR(5), + numexplodingsheep INTEGER, + hasvomit CHAR(1) } } sub create_test_film { - return shift->create({ - Title => 'Bad Taste', - Director => 'Peter Jackson', - Rating => 'R', - NumExplodingSheep => 1, - }); + return shift->create({ + Title => 'Bad Taste', + Director => 'Peter Jackson', + Rating => 'R', + NumExplodingSheep => 1, + }); } package DeletingFilm; diff --git a/t/cdbi/testlib/Lazy.pm b/t/cdbi/testlib/Lazy.pm index 5835de2..594032c 100644 --- a/t/cdbi/testlib/Lazy.pm +++ b/t/cdbi/testlib/Lazy.pm @@ -12,14 +12,14 @@ __PACKAGE__->columns('horizon', qw(eep orp)); __PACKAGE__->columns('vertical', qw(oop opop)); sub create_sql { - return qq{ - this INTEGER, - that INTEGER, - eep INTEGER, - orp INTEGER, - oop INTEGER, - opop INTEGER - }; + return qq{ + this INTEGER, + that INTEGER, + eep INTEGER, + orp INTEGER, + oop INTEGER, + opop INTEGER + }; } 1; diff --git a/t/cdbi/testlib/Log.pm b/t/cdbi/testlib/Log.pm index b521e5e..1d1c209 100644 --- a/t/cdbi/testlib/Log.pm +++ b/t/cdbi/testlib/Log.pm @@ -10,21 +10,21 @@ use POSIX; __PACKAGE__->set_table(); __PACKAGE__->columns(All => qw/id message datetime_stamp/); __PACKAGE__->has_a( - datetime_stamp => 'Time::Piece', - inflate => 'from_mysql_datetime', - deflate => 'mysql_datetime' + datetime_stamp => 'Time::Piece', + inflate => 'from_mysql_datetime', + deflate => 'mysql_datetime' ); __PACKAGE__->add_trigger(before_create => \&set_dts); __PACKAGE__->add_trigger(before_update => \&set_dts); sub set_dts { - shift->datetime_stamp( - POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime(time))); + shift->datetime_stamp( + POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime(time))); } sub create_sql { - return qq{ + return qq{ id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY, message VARCHAR(255), datetime_stamp DATETIME diff --git a/t/cdbi/testlib/MyBase.pm b/t/cdbi/testlib/MyBase.pm index 5dfbfed..aab76fe 100644 --- a/t/cdbi/testlib/MyBase.pm +++ b/t/cdbi/testlib/MyBase.pm @@ -17,30 +17,30 @@ END { $dbh->do("DROP TABLE $_") foreach @table } __PACKAGE__->connection(@connect); sub set_table { - my $class = shift; - $class->table($class->create_test_table); + my $class = shift; + $class->table($class->create_test_table); } sub create_test_table { - my $self = shift; - my $table = $self->next_available_table; - my $create = sprintf "CREATE TABLE $table ( %s )", $self->create_sql; - push @table, $table; - $dbh->do($create); - return $table; + my $self = shift; + my $table = $self->next_available_table; + my $create = sprintf "CREATE TABLE $table ( %s )", $self->create_sql; + push @table, $table; + $dbh->do($create); + return $table; } sub next_available_table { - my $self = shift; - my @tables = sort @{ - $dbh->selectcol_arrayref( - qq{ + my $self = shift; + my @tables = sort @{ + $dbh->selectcol_arrayref( + qq{ SHOW TABLES } - ) - }; - my $table = $tables[-1] || "aaa"; - return "z$table"; + ) + }; + my $table = $tables[-1] || "aaa"; + return "z$table"; } 1; diff --git a/t/cdbi/testlib/MyFilm.pm b/t/cdbi/testlib/MyFilm.pm index d0ae5f8..9e1c007 100644 --- a/t/cdbi/testlib/MyFilm.pm +++ b/t/cdbi/testlib/MyFilm.pm @@ -16,7 +16,7 @@ sub _carp { } sub stars { map $_->star, shift->_stars } sub create_sql { - return qq{ + return qq{ filmid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY, title VARCHAR(255) }; diff --git a/t/cdbi/testlib/MyFoo.pm b/t/cdbi/testlib/MyFoo.pm index 4fbc989..08e4821 100644 --- a/t/cdbi/testlib/MyFoo.pm +++ b/t/cdbi/testlib/MyFoo.pm @@ -10,14 +10,14 @@ use strict; __PACKAGE__->set_table(); __PACKAGE__->columns(All => qw/myid name val tdate/); __PACKAGE__->has_a( - tdate => 'Date::Simple', - inflate => sub { Date::Simple->new(shift) }, - deflate => 'format', + tdate => 'Date::Simple', + inflate => sub { Date::Simple->new(shift) }, + deflate => 'format', ); #__PACKAGE__->find_column('tdate')->placeholder("IF(1, CURDATE(), ?)"); sub create_sql { - return qq{ + return qq{ myid mediumint not null auto_increment primary key, name varchar(50) not null default '', val char(1) default 'A', diff --git a/t/cdbi/testlib/MyStar.pm b/t/cdbi/testlib/MyStar.pm index 22c1544..ec68fa9 100644 --- a/t/cdbi/testlib/MyStar.pm +++ b/t/cdbi/testlib/MyStar.pm @@ -12,10 +12,10 @@ __PACKAGE__->has_many(films => [ MyStarLink => 'film' ]); # sub films { map $_->film, shift->_films } sub create_sql { - return qq{ - starid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY, - name VARCHAR(255) - }; + return qq{ + starid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY, + name VARCHAR(255) + }; } 1; diff --git a/t/cdbi/testlib/MyStarLink.pm b/t/cdbi/testlib/MyStarLink.pm index 143c2f4..5efb279 100644 --- a/t/cdbi/testlib/MyStarLink.pm +++ b/t/cdbi/testlib/MyStarLink.pm @@ -11,7 +11,7 @@ __PACKAGE__->has_a(film => 'MyFilm'); __PACKAGE__->has_a(star => 'MyStar'); sub create_sql { - return qq{ + return qq{ linkid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY, film TINYINT NOT NULL, star TINYINT NOT NULL diff --git a/t/cdbi/testlib/MyStarLinkMCPK.pm b/t/cdbi/testlib/MyStarLinkMCPK.pm index dfc3ff2..f22e5f3 100644 --- a/t/cdbi/testlib/MyStarLinkMCPK.pm +++ b/t/cdbi/testlib/MyStarLinkMCPK.pm @@ -18,7 +18,7 @@ __PACKAGE__->has_a(film => 'MyFilm'); __PACKAGE__->has_a(star => 'MyStar'); sub create_sql { - return qq{ + return qq{ film INTEGER NOT NULL, star INTEGER NOT NULL, PRIMARY KEY (film, star) diff --git a/t/cdbi/testlib/Order.pm b/t/cdbi/testlib/Order.pm index fa1f296..337329a 100644 --- a/t/cdbi/testlib/Order.pm +++ b/t/cdbi/testlib/Order.pm @@ -10,10 +10,10 @@ __PACKAGE__->columns(Primary => 'film'); __PACKAGE__->columns(Others => qw/orders/); sub create_sql { - return qq{ - film VARCHAR(255), - orders INTEGER - }; + return qq{ + film VARCHAR(255), + orders INTEGER + }; } 1; diff --git a/t/cdbi/testlib/OtherFilm.pm b/t/cdbi/testlib/OtherFilm.pm index 5d97101..888e521 100644 --- a/t/cdbi/testlib/OtherFilm.pm +++ b/t/cdbi/testlib/OtherFilm.pm @@ -1,4 +1,4 @@ -package # hide from PAUSE +package # hide from PAUSE OtherFilm; use strict; @@ -7,14 +7,14 @@ use base 'Film'; __PACKAGE__->set_table('Different_Film'); sub create_sql { - return qq{ - title VARCHAR(255), - director VARCHAR(80), - codirector VARCHAR(80), - rating CHAR(5), - numexplodingsheep INTEGER, - hasvomit CHAR(1) - }; + return qq{ + title VARCHAR(255), + director VARCHAR(80), + codirector VARCHAR(80), + rating CHAR(5), + numexplodingsheep INTEGER, + hasvomit CHAR(1) + }; } 1;