From: Aran Deltac Date: Thu, 25 May 2006 18:34:59 +0000 (+0000) Subject: Delete t/run/ and t/helperrels/ so that the reorganize_tests branch can merge in... X-Git-Tag: v0.07002~75^2~166 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=263e41beb22b3753c1a263d923f09386b21c1d38;p=dbsrgits%2FDBIx-Class.git Delete t/run/ and t/helperrels/ so that the reorganize_tests branch can merge in easly. --- diff --git a/t/helperrels/01core.t b/t/helperrels/01core.t deleted file mode 100644 index 1829aef..0000000 --- a/t/helperrels/01core.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/01core.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/04db.t b/t/helperrels/04db.t deleted file mode 100644 index 5051ac3..0000000 --- a/t/helperrels/04db.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/04db.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/05multipk.t b/t/helperrels/05multipk.t deleted file mode 100644 index fc5b046..0000000 --- a/t/helperrels/05multipk.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/05multipk.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/06relationship.t b/t/helperrels/06relationship.t deleted file mode 100644 index c56d936..0000000 --- a/t/helperrels/06relationship.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/06relationship.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/07pager.t b/t/helperrels/07pager.t deleted file mode 100644 index a0b192f..0000000 --- a/t/helperrels/07pager.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/07pager.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/08inflate.t b/t/helperrels/08inflate.t deleted file mode 100644 index 9f1afb5..0000000 --- a/t/helperrels/08inflate.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/08inflate.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/08inflate_has_a.t b/t/helperrels/08inflate_has_a.t deleted file mode 100644 index 32641eb..0000000 --- a/t/helperrels/08inflate_has_a.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/08inflate_has_a.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/08inflate_serialize.t b/t/helperrels/08inflate_serialize.t deleted file mode 100644 index e0ca1d8..0000000 --- a/t/helperrels/08inflate_serialize.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/08inflate_serialize.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/09update.t b/t/helperrels/09update.t deleted file mode 100644 index 05cc63e..0000000 --- a/t/helperrels/09update.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/09update.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/10auto.t b/t/helperrels/10auto.t deleted file mode 100644 index 94c0c7c..0000000 --- a/t/helperrels/10auto.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/10auto.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/11mysql.t b/t/helperrels/11mysql.t deleted file mode 100644 index 397f961..0000000 --- a/t/helperrels/11mysql.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/11mysql.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/12pg.t b/t/helperrels/12pg.t deleted file mode 100644 index 281289d..0000000 --- a/t/helperrels/12pg.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/12pg.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/13oracle.t b/t/helperrels/13oracle.t deleted file mode 100644 index 25a6e51..0000000 --- a/t/helperrels/13oracle.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/13oracle.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/145db2.t b/t/helperrels/145db2.t deleted file mode 100644 index c6925ef..0000000 --- a/t/helperrels/145db2.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/145db2.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/146db2_400.t b/t/helperrels/146db2_400.t deleted file mode 100644 index 655bc05..0000000 --- a/t/helperrels/146db2_400.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/146db2_400.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/14mssql.t b/t/helperrels/14mssql.t deleted file mode 100644 index b43847f..0000000 --- a/t/helperrels/14mssql.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/14mssql.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/15limit.t b/t/helperrels/15limit.t deleted file mode 100644 index fa22b73..0000000 --- a/t/helperrels/15limit.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/15limit.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/16joins.t b/t/helperrels/16joins.t deleted file mode 100644 index bf451e9..0000000 --- a/t/helperrels/16joins.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/16joins.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/17join_count.t b/t/helperrels/17join_count.t deleted file mode 100644 index 531d9ff..0000000 --- a/t/helperrels/17join_count.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/17join_count.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/18self_referencial.t b/t/helperrels/18self_referencial.t deleted file mode 100644 index 6cec715..0000000 --- a/t/helperrels/18self_referencial.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/18self_referencial.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/19uuid.t b/t/helperrels/19uuid.t deleted file mode 100644 index 2d0d4cb..0000000 --- a/t/helperrels/19uuid.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/19uuid.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/20unique.t b/t/helperrels/20unique.t deleted file mode 100644 index 91eed2c..0000000 --- a/t/helperrels/20unique.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/20unique.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/21transactions.t b/t/helperrels/21transactions.t deleted file mode 100644 index 5730483..0000000 --- a/t/helperrels/21transactions.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/21transactions.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/22cascade_copy.t b/t/helperrels/22cascade_copy.t deleted file mode 100644 index bc124e1..0000000 --- a/t/helperrels/22cascade_copy.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/22cascade_copy.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/23cache.t b/t/helperrels/23cache.t deleted file mode 100644 index 73bc31a..0000000 --- a/t/helperrels/23cache.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/23cache.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/24serialize.t b/t/helperrels/24serialize.t deleted file mode 100644 index bc51393..0000000 --- a/t/helperrels/24serialize.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/24serialize.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/25utf8.t b/t/helperrels/25utf8.t deleted file mode 100644 index ad3fe14..0000000 --- a/t/helperrels/25utf8.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/25utf8.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/26might_have.t b/t/helperrels/26might_have.t deleted file mode 100644 index d3ec615..0000000 --- a/t/helperrels/26might_have.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/26might_have.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/26sqlt.t b/t/helperrels/26sqlt.t deleted file mode 100644 index bdcd088..0000000 --- a/t/helperrels/26sqlt.t +++ /dev/null @@ -1,224 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -eval "use SQL::Translator"; -plan skip_all => 'SQL::Translator required' if $@; - -# do not taunt happy dave ball - -my $schema = DBICTest::Schema; - -plan tests => 31; - -my $translator = SQL::Translator->new( - parser_args => { - 'DBIx::Schema' => $schema, - }, - producer_args => { - }, -); - -$translator->parser('SQL::Translator::Parser::DBIx::Class'); -$translator->producer('SQLite'); - -my $output = $translator->translate(); - -my @fk_constraints = - ( - {'display' => 'twokeys->cd', - 'selftable' => 'twokeys', 'foreigntable' => 'cd', - 'selfcols' => ['cd'], 'foreigncols' => ['cdid'], - 'needed' => 1, on_delete => '', on_update => ''}, - {'display' => 'twokeys->artist', - 'selftable' => 'twokeys', 'foreigntable' => 'artist', - 'selfcols' => ['artist'], 'foreigncols' => ['artistid'], - 'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'}, - {'display' => 'cd_to_producer->cd', - 'selftable' => 'cd_to_producer', 'foreigntable' => 'cd', - 'selfcols' => ['cd'], 'foreigncols' => ['cdid'], - 'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'}, - {'display' => 'cd_to_producer->producer', - 'selftable' => 'cd_to_producer', 'foreigntable' => 'producer', - 'selfcols' => ['producer'], 'foreigncols' => ['producerid'], - 'needed' => 1, on_delete => '', on_update => ''}, - {'display' => 'self_ref_alias -> self_ref for self_ref', - 'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref', - 'selfcols' => ['self_ref'], 'foreigncols' => ['id'], - 'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'}, - {'display' => 'self_ref_alias -> self_ref for alias', - 'selftable' => 'self_ref_alias', 'foreigntable' => 'self_ref', - 'selfcols' => ['alias'], 'foreigncols' => ['id'], - 'needed' => 1, on_delete => '', on_update => ''}, - {'display' => 'cd -> artist', - 'selftable' => 'cd', 'foreigntable' => 'artist', - 'selfcols' => ['artist'], 'foreigncols' => ['artistid'], - 'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'}, - {'display' => 'artist_undirected_map -> artist for id1', - 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist', - 'selfcols' => ['id1'], 'foreigncols' => ['artistid'], - 'needed' => 1, on_delete => 'CASCADE', on_update => ''}, - {'display' => 'artist_undirected_map -> artist for id2', - 'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist', - 'selfcols' => ['id2'], 'foreigncols' => ['artistid'], - 'needed' => 1, on_delete => 'CASCADE', on_update => ''}, - {'display' => 'track->cd', - 'selftable' => 'track', 'foreigntable' => 'cd', - 'selfcols' => ['cd'], 'foreigncols' => ['cdid'], - 'needed' => 2, on_delete => 'CASCADE', on_update => 'CASCADE'}, - {'display' => 'treelike -> treelike for parent', - 'selftable' => 'treelike', 'foreigntable' => 'treelike', - 'selfcols' => ['parent'], 'foreigncols' => ['id'], - 'needed' => 1, on_delete => '', on_update => ''}, - - # shouldn't this be generated? - # - #{'display' => 'twokeytreelike -> twokeytreelike for parent1,parent2', - # 'selftable' => 'twokeytreelike', 'foreigntable' => 'twokeytreelike', - # 'selfcols' => ['parent1', 'parent2'], 'foreigncols' => ['id1','id2'], - # 'needed' => 1, on_delete => '', on_update => ''}, - - {'display' => 'tags -> cd', - 'selftable' => 'tags', 'foreigntable' => 'cd', - 'selfcols' => ['cd'], 'foreigncols' => ['cdid'], - 'needed' => 1, on_delete => 'CASCADE', on_update => 'CASCADE'}, - {'display' => 'bookmark -> link', - 'selftable' => 'bookmark', 'foreigntable' => 'link', - 'selfcols' => ['link'], 'foreigncols' => ['id'], - 'needed' => 1, on_delete => '', on_update => ''}, - ); - -my @unique_constraints = ( - {'display' => 'cd artist and title unique', - 'table' => 'cd', 'cols' => ['artist', 'title'], - 'needed' => 1}, - {'display' => 'twokeytreelike name unique', - 'table' => 'twokeytreelike', 'cols' => ['name'], - 'needed' => 1}, -# {'display' => 'employee position and group_id unique', -# 'table' => 'employee', cols => ['position', 'group_id'], -# 'needed' => 1}, -); - -my $tschema = $translator->schema(); -for my $table ($tschema->get_tables) { - my $table_name = $table->name; - for my $c ( $table->get_constraints ) { - if ($c->type eq 'FOREIGN KEY') { - ok(check_fk($table_name, scalar $c->fields, - $c->reference_table, scalar $c->reference_fields, - $c->on_delete, $c->on_update), "Foreign key constraint on $table_name matches an expected constraint"); - } - elsif ($c->type eq 'UNIQUE') { - ok(check_unique($table_name, scalar $c->fields), - "Unique constraint on $table_name matches an expected constraint"); - } - } -} - -# Make sure all the foreign keys are done. -my $i; -for ($i = 0; $i <= $#fk_constraints; ++$i) { - ok(!$fk_constraints[$i]->{'needed'}, "Constraint $fk_constraints[$i]->{display}"); -} -# Make sure all the uniques are done. -for ($i = 0; $i <= $#unique_constraints; ++$i) { - ok(!$unique_constraints[$i]->{'needed'}, "Constraint $unique_constraints[$i]->{display}"); -} - -sub check_fk { - my ($selftable, $selfcol, $foreigntable, $foreigncol, $ondel, $onupd) = @_; - - $ondel = '' if (!defined($ondel)); - $onupd = '' if (!defined($onupd)); - - my $i; - for ($i = 0; $i <= $#fk_constraints; ++$i) { - if ($selftable eq $fk_constraints[$i]->{'selftable'} && - $foreigntable eq $fk_constraints[$i]->{'foreigntable'} && - ($ondel eq $fk_constraints[$i]->{on_delete}) && - ($onupd eq $fk_constraints[$i]->{on_update})) { - # check columns - - my $found = 0; - for (my $j = 0; $j <= $#$selfcol; ++$j) { - $found = 0; - for (my $k = 0; $k <= $#{$fk_constraints[$i]->{'selfcols'}}; ++$k) { - if ($selfcol->[$j] eq $fk_constraints[$i]->{'selfcols'}->[$k] && - $foreigncol->[$j] eq $fk_constraints[$i]->{'foreigncols'}->[$k]) { - $found = 1; - last; - } - } - last unless $found; - } - - if ($found) { - for (my $j = 0; $j <= $#{$fk_constraints[$i]->{'selfcols'}}; ++$j) { - $found = 0; - for (my $k = 0; $k <= $#$selfcol; ++$k) { - if ($selfcol->[$k] eq $fk_constraints[$i]->{'selfcols'}->[$j] && - $foreigncol->[$k] eq $fk_constraints[$i]->{'foreigncols'}->[$j]) { - $found = 1; - last; - } - } - last unless $found; - } - } - - if ($found) { - --$fk_constraints[$i]->{needed}; - return 1; - } - } - } - return 0; -} - -sub check_unique { - my ($selftable, $selfcol) = @_; - - $ondel = '' if (!defined($ondel)); - $onupd = '' if (!defined($onupd)); - - my $i; - for ($i = 0; $i <= $#unique_constraints; ++$i) { - if ($selftable eq $unique_constraints[$i]->{'table'}) { - - my $found = 0; - for (my $j = 0; $j <= $#$selfcol; ++$j) { - $found = 0; - for (my $k = 0; $k <= $#{$unique_constraints[$i]->{'cols'}}; ++$k) { - if ($selfcol->[$j] eq $unique_constraints[$i]->{'cols'}->[$k]) { - $found = 1; - last; - } - } - last unless $found; - } - - if ($found) { - for (my $j = 0; $j <= $#{$unique_constraints[$i]->{'cols'}}; ++$j) { - $found = 0; - for (my $k = 0; $k <= $#$selfcol; ++$k) { - if ($selfcol->[$k] eq $unique_constraints[$i]->{'cols'}->[$j]) { - $found = 1; - last; - } - } - last unless $found; - } - } - - if ($found) { - --$unique_constraints[$i]->{needed}; - return 1; - } - } - } - return 0; -} diff --git a/t/helperrels/27ordered.t b/t/helperrels/27ordered.t deleted file mode 100644 index 352a730..0000000 --- a/t/helperrels/27ordered.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/27ordered.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/28result_set_column.t b/t/helperrels/28result_set_column.t deleted file mode 100644 index 105b5c7..0000000 --- a/t/helperrels/28result_set_column.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/28result_set_column.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/29dbicadmin.t b/t/helperrels/29dbicadmin.t deleted file mode 100644 index ea5882e..0000000 --- a/t/helperrels/29dbicadmin.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/29dbicadmin.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/29inflate_datetime.t b/t/helperrels/29inflate_datetime.t deleted file mode 100644 index aacf84a..0000000 --- a/t/helperrels/29inflate_datetime.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/29inflate_datetime.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/30ensure_class_loaded.t b/t/helperrels/30ensure_class_loaded.t deleted file mode 100644 index 6edbe80..0000000 --- a/t/helperrels/30ensure_class_loaded.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/30ensure_class_loaded.tl"; -run_tests(DBICTest->schema); diff --git a/t/helperrels/30join_torture.t b/t/helperrels/30join_torture.t deleted file mode 100644 index 1e85aeb..0000000 --- a/t/helperrels/30join_torture.t +++ /dev/null @@ -1,7 +0,0 @@ -use Test::More; -use lib qw(t/lib); -use DBICTest; -use DBICTest::HelperRels; - -require "t/run/30join_torture.tl"; -run_tests(DBICTest->schema); diff --git a/t/run/01core.tl b/t/run/01core.tl deleted file mode 100644 index c3c593f..0000000 --- a/t/run/01core.tl +++ /dev/null @@ -1,286 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 58; - -# figure out if we've got a version of sqlite that is older than 3.2.6, in -# which case COUNT(DISTINCT()) doesn't work -my $is_broken_sqlite = 0; -my ($sqlite_major_ver,$sqlite_minor_ver,$sqlite_patch_ver) = - split /\./, $schema->storage->dbh->get_info(18); -if( $schema->storage->dbh->get_info(17) eq 'SQLite' && - ( ($sqlite_major_ver < 3) || - ($sqlite_major_ver == 3 && $sqlite_minor_ver < 2) || - ($sqlite_major_ver == 3 && $sqlite_minor_ver == 2 && $sqlite_patch_ver < 6) ) ) { - $is_broken_sqlite = 1; -} - - -my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'}); - -cmp_ok(@art, '==', 3, "Three artists returned"); - -my $art = $art[0]; - -is($art->name, 'We Are Goth', "Correct order too"); - -$art->name('We Are In Rehab'); - -is($art->name, 'We Are In Rehab', "Accessor update ok"); - -is($art->get_column("name"), 'We Are In Rehab', 'And via get_column'); - -ok($art->update, 'Update run'); - -my $record_jp = $schema->resultset("Artist")->search(undef, { join => 'cds' })->search(undef, { prefetch => 'cds' })->next; - -ok($record_jp, "prefetch on same rel okay"); - -my $record_fn = $schema->resultset("Artist")->search(undef, { join => 'cds' })->search({'cds.cdid' => '1'}, {join => 'artist_undirected_maps'})->next; - -ok($record_fn, "funny join is okay"); - -@art = $schema->resultset("Artist")->search({ name => 'We Are In Rehab' }); - -cmp_ok(@art, '==', 1, "Changed artist returned by search"); - -cmp_ok($art[0]->artistid, '==', 3,'Correct artist too'); - -$art->delete; - -@art = $schema->resultset("Artist")->search({ }); - -cmp_ok(@art, '==', 2, 'And then there were two'); - -ok(!$art->in_storage, "It knows it's dead"); - -eval { $art->delete; }; - -ok($@, "Can't delete twice: $@"); - -is($art->name, 'We Are In Rehab', 'But the object is still live'); - -$art->insert; - -ok($art->in_storage, "Re-created"); - -@art = $schema->resultset("Artist")->search({ }); - -cmp_ok(@art, '==', 3, 'And now there are three again'); - -my $new = $schema->resultset("Artist")->create({ artistid => 4 }); - -cmp_ok($new->artistid, '==', 4, 'Create produced record ok'); - -@art = $schema->resultset("Artist")->search({ }); - -cmp_ok(@art, '==', 4, "Oh my god! There's four of them!"); - -$new->set_column('name' => 'Man With A Fork'); - -is($new->name, 'Man With A Fork', 'set_column ok'); - -$new->discard_changes; - -ok(!defined $new->name, 'Discard ok'); - -$new->name('Man With A Spoon'); - -$new->update; - -my $new_again = $schema->resultset("Artist")->find(4); - -is($new_again->name, 'Man With A Spoon', 'Retrieved correctly'); - -is($new_again->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id generated correctly'); - -# Test backwards compatibility -{ - my $artist_by_hash = $schema->resultset('Artist')->find(artistid => 4); - is($artist_by_hash->name, 'Man With A Spoon', 'Retrieved correctly'); - is($artist_by_hash->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id generated correctly'); -} - -is($schema->resultset("Artist")->count, 4, 'count ok'); - -# test find_or_new -{ - my $existing_obj = $schema->resultset('Artist')->find_or_new({ - artistid => 4, - }); - - is($existing_obj->name, 'Man With A Spoon', 'find_or_new: found existing artist'); - ok($existing_obj->in_storage, 'existing artist is in storage'); - - my $new_obj = $schema->resultset('Artist')->find_or_new({ - artistid => 5, - name => 'find_or_new', - }); - - is($new_obj->name, 'find_or_new', 'find_or_new: instantiated a new artist'); - ok(! $new_obj->in_storage, 'new artist is not in storage'); -} - -my $cd = $schema->resultset("CD")->find(1); -my %cols = $cd->get_columns; - -cmp_ok(keys %cols, '==', 4, 'get_columns number of columns ok'); - -is($cols{title}, 'Spoonful of bees', 'get_columns values ok'); - -%cols = ( title => 'Forkful of bees', year => 2005); -$cd->set_columns(\%cols); - -is($cd->title, 'Forkful of bees', 'set_columns ok'); - -is($cd->year, 2005, 'set_columns ok'); - -$cd->discard_changes; - -# check whether ResultSource->columns returns columns in order originally supplied -my @cd = $schema->source("CD")->columns; - -is_deeply( \@cd, [qw/cdid artist title year/], 'column order'); - -$cd = $schema->resultset("CD")->search({ title => 'Spoonful of bees' }, { columns => ['title'] })->next; -is($cd->title, 'Spoonful of bees', 'subset of columns returned correctly'); - -$cd = $schema->resultset("CD")->search(undef, { include_columns => [ 'artist.name' ], join => [ 'artist' ] })->find(1); - -is($cd->title, 'Spoonful of bees', 'Correct CD returned with include'); -is($cd->get_column('name'), 'Caterwauler McCrae', 'Additional column returned'); - -# update_or_insert -$new = $schema->resultset("Track")->new( { - trackid => 100, - cd => 1, - position => 1, - title => 'Insert or Update', -} ); -$new->update_or_insert; -ok($new->in_storage, 'update_or_insert insert ok'); - -# test in update mode -$new->pos(5); -$new->update_or_insert; -is( $schema->resultset("Track")->find(100)->pos, 5, 'update_or_insert update ok'); - -eval { $schema->class("Track")->load_components('DoesNotExist'); }; - -ok $@, $@; - -is($schema->class("Artist")->field_name_for->{name}, 'artist name', 'mk_classdata usage ok'); - -my $search = [ { 'tags.tag' => 'Cheesy' }, { 'tags.tag' => 'Blue' } ]; - -my( $or_rs ) = $schema->resultset("CD")->search_rs($search, { join => 'tags', - order_by => 'cdid' }); - -cmp_ok($or_rs->count, '==', 5, 'Search with OR ok'); - -my $distinct_rs = $schema->resultset("CD")->search($search, { join => 'tags', distinct => 1 }); -cmp_ok($distinct_rs->all, '==', 4, 'DISTINCT search with OR ok'); - -SKIP: { - skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1 - if $is_broken_sqlite; - - my $tcount = $schema->resultset("Track")->search( - {}, - { - select => {count => {distinct => ['position', 'title']}}, - as => ['count'] - } - ); - cmp_ok($tcount->next->get_column('count'), '==', 13, 'multiple column COUNT DISTINCT ok'); - -} -my $tag_rs = $schema->resultset('Tag')->search( - [ { 'me.tag' => 'Cheesy' }, { 'me.tag' => 'Blue' } ]); - -my $rel_rs = $tag_rs->search_related('cd'); - -cmp_ok($rel_rs->count, '==', 5, 'Related search ok'); - -cmp_ok($or_rs->next->cdid, '==', $rel_rs->next->cdid, 'Related object ok'); -$or_rs->reset; -$rel_rs->reset; - -my $tag = $schema->resultset('Tag')->search( - [ { 'me.tag' => 'Blue' } ], { cols=>[qw/tagid/] } )->next; - -cmp_ok($tag->has_column_loaded('tagid'), '==', 1, 'Has tagid loaded'); -cmp_ok($tag->has_column_loaded('tag'), '==', 0, 'Has not tag loaded'); - -ok($schema->storage(), 'Storage available'); - -{ - my $rs = $schema->resultset("Artist")->search({ - -and => [ - artistid => { '>=', 1 }, - artistid => { '<', 3 } - ] - }); - - $rs->update({ name => 'Test _cond_for_update_delete' }); - - my $art; - - $art = $schema->resultset("Artist")->find(1); - is($art->name, 'Test _cond_for_update_delete', 'updated first artist name'); - - $art = $schema->resultset("Artist")->find(2); - is($art->name, 'Test _cond_for_update_delete', 'updated second artist name'); -} - -# test source_name -{ - # source_name should be set for normal modules - is($schema->source('CD')->source_name, 'CD', 'source_name is set to moniker'); - - # test the result source that sets source_name explictly - ok($schema->source('SourceNameArtists'), 'SourceNameArtists result source exists'); - - my @artsn = $schema->resultset('SourceNameArtists')->search({}, { order_by => 'name DESC' }); - cmp_ok(@artsn, '==', 4, "Four artists returned"); -} - -my $newbook = $schema->resultset( 'Bookmark' )->find(1); - -$@ = ''; -eval { -my $newlink = $newbook->link; -}; -ok(!$@, "stringify to false value doesn't cause error"); - -# test cascade_delete through many_to_many relations -{ - my $art_del = $schema->resultset("Artist")->find({ artistid => 1 }); - $art_del->delete; - cmp_ok( $schema->resultset("CD")->search({artist => 1}), '==', 0, 'Cascading through has_many top level.'); - cmp_ok( $schema->resultset("CD_to_Producer")->search({cd => 1}), '==', 0, 'Cascading through has_many children.'); -} - -# test column_info -{ - $schema->source("Artist")->{_columns}{'artistid'} = {}; - - my $typeinfo = $schema->source("Artist")->column_info('artistid'); - is($typeinfo->{data_type}, 'INTEGER', 'column_info ok'); - $schema->source("Artist")->column_info('artistid'); - ok($schema->source("Artist")->{_columns_info_loaded} == 1, 'Columns info flag set'); -} - -# test remove_columns -{ - is_deeply([$schema->source('CD')->columns], [qw/cdid artist title year/]); - $schema->source('CD')->remove_columns('year'); - is_deeply([$schema->source('CD')->columns], [qw/cdid artist title/]); -} - diff --git a/t/run/04db.tl b/t/run/04db.tl deleted file mode 100644 index 5208614..0000000 --- a/t/run/04db.tl +++ /dev/null @@ -1,56 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 3; - -# add some rows inside a transaction and commit it -# XXX: Is storage->dbh the only way to get a dbh? -$schema->storage->txn_begin; -for (10..15) { - $schema->resultset("Artist")->create( { - artistid => $_, - name => "artist number $_", - } ); -} -$schema->storage->txn_commit; -my ($artist) = $schema->resultset("Artist")->find(15); -is($artist->name, 'artist number 15', "Commit ok"); - -# add some rows inside a transaction and roll it back -$schema->storage->txn_begin; -for (21..30) { - $schema->resultset("Artist")->create( { - artistid => $_, - name => "artist number $_", - } ); -} -$schema->storage->txn_rollback; -($artist) = $schema->resultset("Artist")->search( artistid => 25 ); -is($artist, undef, "Rollback ok"); - -my $type_info = $schema->storage->columns_info_for('artist'); - -# I know this is gross but SQLite reports the size differently from release -# to release. At least this way the test still passes. - -delete $type_info->{artistid}{size}; -delete $type_info->{name}{size}; - -my $test_type_info = { - 'artistid' => { - 'data_type' => 'INTEGER', - 'is_nullable' => 0, - }, - 'name' => { - 'data_type' => 'varchar', - 'is_nullable' => 0, - }, -}; -is_deeply($type_info, $test_type_info, 'columns_info_for - column data types'); - diff --git a/t/run/05multipk.tl b/t/run/05multipk.tl deleted file mode 100644 index 5cea1fd..0000000 --- a/t/run/05multipk.tl +++ /dev/null @@ -1,17 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 4; - -my $artist = DBICTest::Artist->find(1); -ok($artist->find_related('twokeys', {cd => 1}), "find multiple pks using relationships + args"); -ok($schema->resultset("FourKeys")->find(1,2,3,4), "find multiple pks without hash"); -ok($schema->resultset("FourKeys")->find(5,4,3,6), "find multiple pks without hash"); -is($schema->resultset("FourKeys")->find(1,2,3,4)->ID, 'DBICTest::FourKeys|fourkeys|bar=2|foo=1|goodbye=4|hello=3', 'unique object id ok for multiple pks'); - diff --git a/t/run/06relationship.tl b/t/run/06relationship.tl deleted file mode 100644 index 45ed343..0000000 --- a/t/run/06relationship.tl +++ /dev/null @@ -1,168 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 32; - -# has_a test -my $cd = $schema->resultset("CD")->find(4); -my ($artist) = ($INC{'DBICTest/HelperRels'} - ? $cd->artist - : $cd->search_related('artist')); -is($artist->name, 'Random Boy Band', 'has_a search_related ok'); - -# has_many test with an order_by clause defined -$artist = $schema->resultset("Artist")->find(1); -my @cds = ($INC{'DBICTest/HelperRels'} - ? $artist->cds - : $artist->search_related('cds')); -is( $cds[1]->title, 'Spoonful of bees', 'has_many search_related with order_by ok' ); - -# search_related with additional abstract query -@cds = ($INC{'DBICTest/HelperRels'} - ? $artist->cds({ title => { like => '%of%' } }) - : $artist->search_related('cds', { title => { like => '%of%' } } ) - ); -is( $cds[1]->title, 'Forkful of bees', 'search_related with abstract query ok' ); - -# creating a related object -if ($INC{'DBICTest/HelperRels.pm'}) { - $artist->add_to_cds({ title => 'Big Flop', year => 2005 }); -} else { - $artist->create_related( 'cds', { - title => 'Big Flop', - year => 2005, - } ); -} - -is( ($artist->search_related('cds'))[3]->title, 'Big Flop', 'create_related ok' ); - -my( $rs_from_list ) = $artist->search_related_rs('cds'); -is( ref($rs_from_list), 'DBIx::Class::ResultSet', 'search_related_rs in list context returns rs' ); - -( $rs_from_list ) = $artist->cds_rs(); -is( ref($rs_from_list), 'DBIx::Class::ResultSet', 'relation_rs in list context returns rs' ); - -# count_related -is( $artist->count_related('cds'), 4, 'count_related ok' ); - -# set_from_related -my $track = $schema->resultset("Track")->create( { - trackid => 1, - cd => 3, - position => 98, - title => 'Hidden Track' -} ); -$track->set_from_related( cd => $cd ); - -is($track->disc->cdid, 4, 'set_from_related ok, including alternative accessor' ); - -$track->set_from_related( cd => undef ); - -ok( !defined($track->cd), 'set_from_related with undef ok'); - - -# update_from_related, the same as set_from_related, but it calls update afterwards -$track = $schema->resultset("Track")->create( { - trackid => 2, - cd => 3, - position => 99, - title => 'Hidden Track' -} ); -$track->update_from_related( cd => $cd ); - -my $t_cd = ($schema->resultset("Track")->search( cd => 4, position => 99 ))[0]->cd; - -is( $t_cd->cdid, 4, 'update_from_related ok' ); - -# find_or_create_related with an existing record -$cd = $artist->find_or_create_related( 'cds', { title => 'Big Flop' } ); -is( $cd->year, 2005, 'find_or_create_related on existing record ok' ); - -# find_or_create_related creating a new record -$cd = $artist->find_or_create_related( 'cds', { - title => 'Greatest Hits', - year => 2006, -} ); -is( $cd->title, 'Greatest Hits', 'find_or_create_related new record ok' ); -@cds = $artist->search_related('cds'); -is( ($artist->search_related('cds'))[4]->title, 'Greatest Hits', 'find_or_create_related new record search ok' ); - -$artist->delete_related( cds => { title => 'Greatest Hits' }); -cmp_ok( $schema->resultset("CD")->search( title => 'Greatest Hits' ), '==', 0, 'delete_related ok' ); - -# find_or_new_related with an existing record -$cd = $artist->find_or_new_related( 'cds', { title => 'Big Flop' } ); -is( $cd->year, 2005, 'find_or_new_related on existing record ok' ); -ok( $cd->in_storage, 'find_or_new_related on existing record: is in_storage' ); - -# find_or_new_related instantiating a new record -$cd = $artist->find_or_new_related( 'cds', { - title => 'Greatest Hits 2: Louder Than Ever', - year => 2007, -} ); -is( $cd->title, 'Greatest Hits 2: Louder Than Ever', 'find_or_new_related new record ok' ); -ok( ! $cd->in_storage, 'find_or_new_related on a new record: not in_storage' ); - -SKIP: { - skip "relationship checking needs fixing", 1; - # try to add a bogus relationship using the wrong cols - eval { - DBICTest::Schema::Artist->add_relationship( - tracks => 'DBICTest::Schema::Track', - { 'foreign.cd' => 'self.cdid' } - ); - }; - like($@, qr/Unknown column/, 'failed when creating a rel with invalid key, ok'); -} - -# another bogus relationship using no join condition -eval { - DBICTest::Schema::Artist->add_relationship( tracks => 'DBICTest::Track' ); -}; -like($@, qr/join condition/, 'failed when creating a rel without join condition, ok'); - -# many_to_many helper test -$cd = $schema->resultset("CD")->find(1); -my @producers = $cd->producers(); -is( $producers[0]->name, 'Matt S Trout', 'many_to_many ok' ); -is( $cd->producers_sorted->next->name, 'Bob The Builder', 'sorted many_to_many ok' ); -is( $cd->producers_sorted(producerid => 3)->next->name, 'Fred The Phenotype', 'sorted many_to_many with search condition ok' ); - -# test undirected many-to-many relationship (e.g. "related artists") -my $undir_maps = $schema->resultset("Artist")->find(1)->artist_undirected_maps; -is($undir_maps->count, 1, 'found 1 undirected map for artist 1'); - -$undir_maps = $schema->resultset("Artist")->find(2)->artist_undirected_maps; -is($undir_maps->count, 1, 'found 1 undirected map for artist 2'); - -my $mapped_rs = $undir_maps->search_related('mapped_artists'); - -my @art = $mapped_rs->all; - -cmp_ok(@art, '==', 2, "Both artist returned from map"); - -my $searched = $mapped_rs->search({'mapped_artists.artistid' => {'!=', undef}}); - -cmp_ok($searched->count, '==', 2, "Both artist returned from map after adding another condition"); - -# check join through cascaded has_many relationships -$artist = $schema->resultset("Artist")->find(1); -my $trackset = $artist->cds->search_related('tracks'); -# LEFT join means we also see the trackless additional album... -cmp_ok($trackset->count, '==', 11, "Correct number of tracks for artist"); - -# now see about updating eveything that belongs to artist 2 to artist 3 -$artist = $schema->resultset("Artist")->find(2); -my $nartist = $schema->resultset("Artist")->find(3); -cmp_ok($artist->cds->count, '==', 1, "Correct orig #cds for artist"); -cmp_ok($nartist->cds->count, '==', 1, "Correct orig #cds for artist"); -$artist->cds->update({artist => $nartist->id}); -cmp_ok($artist->cds->count, '==', 0, "Correct new #cds for artist"); -cmp_ok($nartist->cds->count, '==', 2, "Correct new #cds for artist"); - diff --git a/t/run/07pager.tl b/t/run/07pager.tl deleted file mode 100644 index 85b1e8d..0000000 --- a/t/run/07pager.tl +++ /dev/null @@ -1,70 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 12; - -# first page -my $it = $schema->resultset("CD")->search( - {}, - { order_by => 'title', - rows => 3, - page => 1 } -); - -is( $it->pager->entries_on_this_page, 3, "entries_on_this_page ok" ); - -is( $it->pager->next_page, 2, "next_page ok" ); - -is( $it->count, 3, "count on paged rs ok" ); - -is( $it->next->title, "Caterwaulin' Blues", "iterator->next ok" ); - -$it->next; -$it->next; - -is( $it->next, undef, "next past end of page ok" ); - -# second page, testing with array -my @page2 = $schema->resultset("CD")->search( - {}, - { order_by => 'title', - rows => 3, - page => 2 } -); - -is( $page2[0]->title, "Generic Manufactured Singles", "second page first title ok" ); - -# page a standard resultset -$it = $schema->resultset("CD")->search( - {}, - { order_by => 'title', - rows => 3 } -); -my $page = $it->page(2); - -is( $page->count, 2, "standard resultset paged rs count ok" ); - -is( $page->next->title, "Generic Manufactured Singles", "second page of standard resultset ok" ); - -# test software-based limit paging -$it = $schema->resultset("CD")->search( - {}, - { order_by => 'title', - rows => 3, - page => 2, - software_limit => 1 } -); -is( $it->pager->entries_on_this_page, 2, "software entries_on_this_page ok" ); - -is( $it->pager->previous_page, 1, "software previous_page ok" ); - -is( $it->count, 2, "software count on paged rs ok" ); - -is( $it->next->title, "Generic Manufactured Singles", "software iterator->next ok" ); - diff --git a/t/run/08inflate.tl b/t/run/08inflate.tl deleted file mode 100644 index 3906a02..0000000 --- a/t/run/08inflate.tl +++ /dev/null @@ -1,35 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -eval { require DateTime }; -plan skip_all => "Need DateTime for inflation tests" if $@; - -plan tests => 3; - -DBICTest::Schema::CD->inflate_column( 'year', - { inflate => sub { DateTime->new( year => shift ) }, - deflate => sub { shift->year } } -); -Class::C3->reinitialize; - -# inflation test -my $cd = $schema->resultset("CD")->find(3); - -is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' ); - -is( $cd->year->month, 1, 'inflated month ok' ); - -# deflate test -my $now = DateTime->now; -$cd->year( $now ); -$cd->update; - -($cd) = $schema->resultset("CD")->search( year => $now->year ); -is( $cd->year->year, $now->year, 'deflate ok' ); - diff --git a/t/run/08inflate_has_a.tl b/t/run/08inflate_has_a.tl deleted file mode 100644 index 266585a..0000000 --- a/t/run/08inflate_has_a.tl +++ /dev/null @@ -1,58 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -eval { require DateTime }; -plan skip_all => "Need DateTime for inflation tests" if $@; - -plan tests => 6; - -DBICTest::Schema::CD->load_components(qw/CDBICompat::HasA/); - -DBICTest::Schema::CD->has_a( 'year', 'DateTime', - inflate => sub { DateTime->new( year => shift ) }, - deflate => sub { shift->year } -); -Class::C3->reinitialize; - -# inflation test -my $cd = $schema->resultset("CD")->find(3); - -is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' ); - -is( $cd->year->month, 1, 'inflated month ok' ); - -# deflate test -my $now = DateTime->now; -$cd->year( $now ); -$cd->update; - -($cd) = $schema->resultset("CD")->search( year => $now->year ); -is( $cd->year->year, $now->year, 'deflate ok' ); - -# re-test using alternate deflate syntax -$schema->class("CD")->has_a( 'year', 'DateTime', - inflate => sub { DateTime->new( year => shift ) }, - deflate => 'year' -); - -# inflation test -$cd = $schema->resultset("CD")->find(3); - -is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' ); - -is( $cd->year->month, 1, 'inflated month ok' ); - -# deflate test -$now = DateTime->now; -$cd->year( $now ); -$cd->update; - -($cd) = $schema->resultset("CD")->search( year => $now->year ); -is( $cd->year->year, $now->year, 'deflate ok' ); - diff --git a/t/run/08inflate_serialize.tl b/t/run/08inflate_serialize.tl deleted file mode 100644 index b51f961..0000000 --- a/t/run/08inflate_serialize.tl +++ /dev/null @@ -1,75 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -use Data::Dumper; - -my @serializers = ( - { module => 'YAML.pm', - inflater => sub { YAML::Load (shift) }, - deflater => sub { die "Expecting a reference" unless (ref $_[0]); YAML::Dump (shift) }, - }, - { module => 'Storable.pm', - inflater => sub { Storable::thaw (shift) }, - deflater => sub { die "Expecting a reference" unless (ref $_[0]); Storable::nfreeze (shift) }, - }, -); - - -my $selected; -foreach my $serializer (@serializers) { - eval { require $serializer->{module} }; - unless ($@) { - $selected = $serializer; - last; - } -} - -plan (skip_all => "No suitable serializer found") unless $selected; - -plan (tests => 6); -DBICTest::Schema::Serialized->inflate_column( 'serialized', - { inflate => $selected->{inflater}, - deflate => $selected->{deflater}, - }, -); -Class::C3->reinitialize; - -my $complex1 = { - id => 1, - serialized => { - a => 1, - b => [ - { c => 2 }, - ], - d => 3, - }, -}; - -my $complex2 = { - id => 1, - serialized => [ - 'a', - { b => 1, c => 2}, - 'd', - ], -}; - -my $rs = $schema->resultset('Serialized'); -my $entry = $rs->create({ id => 1, serialized => ''}); - -my $inflated; - -ok($entry->update ({ %{$complex1} }), 'hashref deflation ok'); -ok($inflated = $entry->serialized, 'hashref inflation ok'); -is_deeply($inflated, $complex1->{serialized}, 'inflated hash matches original'); - -ok($entry->update ({ %{$complex2} }), 'arrayref deflation ok'); -ok($inflated = $entry->serialized, 'arrayref inflation ok'); -is_deeply($inflated, $complex2->{serialized}, 'inflated array matches original'); - diff --git a/t/run/09update.tl b/t/run/09update.tl deleted file mode 100644 index 70d7038..0000000 --- a/t/run/09update.tl +++ /dev/null @@ -1,29 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -BEGIN { - eval "use DBD::SQLite"; - plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 3); -} - -my $art = $schema->resultset("Artist")->find(1); - -isa_ok $art => 'DBICTest::Artist'; - -my $name = 'Caterwauler McCrae'; - -ok($art->name($name) eq $name, 'update'); - -{ - my @changed_keys = $art->is_changed; - is( scalar (@changed_keys), 0, 'field changed but same value' ); -} - -$art->discard_changes; - diff --git a/t/run/10auto.tl b/t/run/10auto.tl deleted file mode 100644 index b108369..0000000 --- a/t/run/10auto.tl +++ /dev/null @@ -1,22 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 2; - -$schema->class("Artist")->load_components(qw/PK::Auto::SQLite/); - # Should just be PK::Auto but this ensures the compat shim works - -# add an artist without primary key to test Auto -my $artist = $schema->resultset("Artist")->create( { name => 'Auto' } ); -$artist->name( 'Auto Change' ); -ok($artist->update, 'update on object created without PK ok'); - -my $copied = $artist->copy({ name => 'Don\'t tell the RIAA', artistid => undef }); -is($copied->name, 'Don\'t tell the RIAA', "Copied with PKs ok."); - diff --git a/t/run/11mysql.tl b/t/run/11mysql.tl deleted file mode 100644 index 93f45fd..0000000 --- a/t/run/11mysql.tl +++ /dev/null @@ -1,77 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/}; - -#warn "$dsn $user $pass"; - -plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test' - unless ($dsn && $user); - -plan tests => 5; - -DBICTest::Schema->compose_connection('MySQLTest' => $dsn, $user, $pass); - -my $dbh = MySQLTest->schema->storage->dbh; - -$dbh->do("DROP TABLE IF EXISTS artist;"); - -$dbh->do("CREATE TABLE artist (artistid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(255), charfield CHAR(10));"); - -#'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', ''); - -MySQLTest::Artist->load_components('PK::Auto'); - -# test primary key handling -my $new = MySQLTest::Artist->create({ name => 'foo' }); -ok($new->artistid, "Auto-PK worked"); - -# test LIMIT support -for (1..6) { - MySQLTest::Artist->create({ name => 'Artist ' . $_ }); -} -my $it = MySQLTest::Artist->search( {}, - { rows => 3, - offset => 2, - order_by => 'artistid' } -); -is( $it->count, 3, "LIMIT count ok" ); -is( $it->next->name, "Artist 2", "iterator->next ok" ); -$it->next; -$it->next; -is( $it->next, undef, "next past end of resultset ok" ); - -my $test_type_info = { - 'artistid' => { - 'data_type' => 'INT', - 'is_nullable' => 0, - 'size' => 11, - 'default_value' => undef, - }, - 'name' => { - 'data_type' => 'VARCHAR', - 'is_nullable' => 1, - 'size' => 255, - 'default_value' => undef, - }, - 'charfield' => { - 'data_type' => 'VARCHAR', - 'is_nullable' => 1, - 'size' => 10, - 'default_value' => undef, - }, -}; - - -my $type_info = MySQLTest->schema->storage->columns_info_for('artist'); -is_deeply($type_info, $test_type_info, 'columns_info_for - column data types'); - - - -# clean up our mess -$dbh->do("DROP TABLE artist"); - diff --git a/t/run/12pg.tl b/t/run/12pg.tl deleted file mode 100644 index 81aae04..0000000 --- a/t/run/12pg.tl +++ /dev/null @@ -1,77 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/}; - -#warn "$dsn $user $pass"; - -plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test' - . ' (note: creates and drops tables named artist and casecheck!)' unless ($dsn && $user); - -plan tests => 8; - -DBICTest::Schema->compose_connection('PgTest' => $dsn, $user, $pass); - -my $dbh = PgTest->schema->storage->dbh; -PgTest->schema->source("Artist")->name("testschema.artist"); -$dbh->do("CREATE SCHEMA testschema;"); - -$dbh->do("CREATE TABLE testschema.artist (artistid serial PRIMARY KEY, name VARCHAR(100), charfield CHAR(10));"); -ok ( $dbh->do('CREATE TABLE testschema.casecheck (id serial PRIMARY KEY, "name" VARCHAR(1), "NAME" VARCHAR(2), "UC_NAME" VARCHAR(3));'), 'Creation of casecheck table'); - -PgTest::Artist->load_components('PK::Auto'); - -my $new = PgTest::Artist->create({ name => 'foo' }); - -is($new->artistid, 1, "Auto-PK worked"); - -$new = PgTest::Artist->create({ name => 'bar' }); - -is($new->artistid, 2, "Auto-PK worked"); - -my $test_type_info = { - 'artistid' => { - 'data_type' => 'integer', - 'is_nullable' => 0, - 'size' => 4, - }, - 'name' => { - 'data_type' => 'character varying', - 'is_nullable' => 1, - 'size' => 100, - 'default_value' => undef, - }, - 'charfield' => { - 'data_type' => 'character', - 'is_nullable' => 1, - 'size' => 10, - 'default_value' => undef, - }, -}; - - -my $type_info = PgTest->schema->storage->columns_info_for('testschema.artist'); -my $artistid_defval = delete $type_info->{artistid}->{default_value}; -like($artistid_defval, - qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/, - 'columns_info_for - sequence matches Pg get_autoinc_seq expectations'); -is_deeply($type_info, $test_type_info, - 'columns_info_for - column data types'); - -my $name_info = PgTest::Casecheck->column_info( 'name' ); -is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" ); - -my $NAME_info = PgTest::Casecheck->column_info( 'NAME' ); -is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" ); - -my $uc_name_info = PgTest::Casecheck->column_info( 'uc_name' ); -is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" ); - -$dbh->do("DROP TABLE testschema.artist;"); -$dbh->do("DROP TABLE testschema.casecheck;"); -$dbh->do("DROP SCHEMA testschema;"); - diff --git a/t/run/13oracle.tl b/t/run/13oracle.tl deleted file mode 100644 index c0489ff..0000000 --- a/t/run/13oracle.tl +++ /dev/null @@ -1,95 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/}; - -plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' . - 'Warning: This test drops and creates tables called \'artist\', \'cd\' and \'track\'' - unless ($dsn && $user && $pass); - -plan tests => 6; - -DBICTest::Schema->compose_connection('OraTest' => $dsn, $user, $pass); - -my $dbh = OraTest->schema->storage->dbh; - -eval { - $dbh->do("DROP SEQUENCE artist_seq"); - $dbh->do("DROP TABLE artist"); - $dbh->do("DROP TABLE cd"); - $dbh->do("DROP TABLE track"); -}; -$dbh->do("CREATE SEQUENCE artist_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); -$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255))"); -$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4))"); -$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255))"); - -$dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))"); -$dbh->do(qq{ - CREATE OR REPLACE TRIGGER artist_insert_trg - BEFORE INSERT ON artist - FOR EACH ROW - BEGIN - IF :new.artistid IS NULL THEN - SELECT artist_seq.nextval - INTO :new.artistid - FROM DUAL; - END IF; - END; -}); - -OraTest::Artist->load_components('PK::Auto'); -OraTest::CD->load_components('PK::Auto::Oracle'); -OraTest::Track->load_components('PK::Auto::Oracle'); - -# test primary key handling -my $new = OraTest::Artist->create({ name => 'foo' }); -is($new->artistid, 1, "Oracle Auto-PK worked"); - -# test join with row count ambiguity -my $cd = OraTest::CD->create({ cdid => 1, artist => 1, title => 'EP C', year => '2003' }); -my $track = OraTest::Track->create({ trackid => 1, cd => 1, position => 1, title => 'Track1' }); -my $tjoin = OraTest::Track->search({ 'me.title' => 'Track1'}, - { join => 'cd', - rows => 2 } -); - -is($tjoin->next->title, 'Track1', "ambiguous column ok"); - -# check count distinct with multiple columns -my $other_track = OraTest::Track->create({ trackid => 2, cd => 1, position => 1, title => 'Track2' }); -my $tcount = OraTest::Track->search( - {}, - { - select => [{count => {distinct => ['position', 'title']}}], - as => ['count'] - } - ); - -is($tcount->next->get_column('count'), 2, "multiple column select distinct ok"); - -# test LIMIT support -for (1..6) { - OraTest::Artist->create({ name => 'Artist ' . $_ }); -} -my $it = OraTest::Artist->search( {}, - { rows => 3, - offset => 2, - order_by => 'artistid' } -); -is( $it->count, 3, "LIMIT count ok" ); -is( $it->next->name, "Artist 2", "iterator->next ok" ); -$it->next; -$it->next; -is( $it->next, undef, "next past end of resultset ok" ); - -# clean up our mess -$dbh->do("DROP SEQUENCE artist_seq"); -$dbh->do("DROP TABLE artist"); -$dbh->do("DROP TABLE cd"); -$dbh->do("DROP TABLE track"); - diff --git a/t/run/145db2.tl b/t/run/145db2.tl deleted file mode 100644 index 36e5e8c..0000000 --- a/t/run/145db2.tl +++ /dev/null @@ -1,74 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_DB2_${_}" } qw/DSN USER PASS/}; - -#warn "$dsn $user $pass"; - -plan skip_all, 'Set $ENV{DBICTEST_DB2_DSN}, _USER and _PASS to run this test' - unless ($dsn && $user); - -plan tests => 6; - -DBICTest::Schema->compose_connection('DB2Test' => $dsn, $user, $pass); - -my $dbh = DB2Test->schema->storage->dbh; - -$dbh->do("DROP TABLE artist", { RaiseError => 0, PrintError => 0 }); - -$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10));"); - -#'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', ''); - -DB2Test::Artist->load_components('PK::Auto'); - -# test primary key handling -my $new = DB2Test::Artist->create({ name => 'foo' }); -ok($new->artistid, "Auto-PK worked"); - -# test LIMIT support -for (1..6) { - DB2Test::Artist->create({ name => 'Artist ' . $_ }); -} -my $it = DB2Test::Artist->search( {}, - { rows => 3, - order_by => 'artistid' - } -); -is( $it->count, 3, "LIMIT count ok" ); -is( $it->next->name, "foo", "iterator->next ok" ); -$it->next; -is( $it->next->name, "Artist 2", "iterator->next ok" ); -is( $it->next, undef, "next past end of resultset ok" ); - -my $test_type_info = { - 'artistid' => { - 'data_type' => 'INTEGER', - 'is_nullable' => 0, - 'size' => 10 - }, - 'name' => { - 'data_type' => 'VARCHAR', - 'is_nullable' => 1, - 'size' => 255 - }, - 'charfield' => { - 'data_type' => 'CHAR', - 'is_nullable' => 1, - 'size' => 10 - }, -}; - - -my $type_info = DB2Test->schema->storage->columns_info_for('artist'); -is_deeply($type_info, $test_type_info, 'columns_info_for - column data types'); - - - -# clean up our mess -$dbh->do("DROP TABLE artist"); - diff --git a/t/run/146db2_400.tl b/t/run/146db2_400.tl deleted file mode 100644 index 6c2344c..0000000 --- a/t/run/146db2_400.tl +++ /dev/null @@ -1,75 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_DB2_400_${_}" } qw/DSN USER PASS/}; - -#warn "$dsn $user $pass"; - -# Probably best to pass the DBQ option in the DSN to specify a specific -# libray. Something like: -# DBICTEST_DB2_400_DSN='dbi:ODBC:dsn=MyAS400;DBQ=MYLIB' -plan skip_all, 'Set $ENV{DBICTEST_DB2_400_DSN}, _USER and _PASS to run this test' - unless ($dsn && $user); - -plan tests => 6; - -DBICTest::Schema->compose_connection('DB2Test' => $dsn, $user, $pass); - -my $dbh = DB2Test->schema->storage->dbh; - -$dbh->do("DROP TABLE artist", { RaiseError => 0, PrintError => 0 }); - -$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10))"); - -DB2Test::Artist->load_components('PK::Auto'); - -# test primary key handling -my $new = DB2Test::Artist->create({ name => 'foo' }); -ok($new->artistid, "Auto-PK worked"); - -# test LIMIT support -for (1..6) { - DB2Test::Artist->create({ name => 'Artist ' . $_ }); -} -my $it = DB2Test::Artist->search( {}, - { rows => 3, - order_by => 'artistid' - } -); -is( $it->count, 3, "LIMIT count ok" ); -is( $it->next->name, "foo", "iterator->next ok" ); -$it->next; -is( $it->next->name, "Artist 2", "iterator->next ok" ); -is( $it->next, undef, "next past end of resultset ok" ); - -my $test_type_info = { - 'artistid' => { - 'data_type' => 'INTEGER', - 'is_nullable' => 0, - 'size' => 10 - }, - 'name' => { - 'data_type' => 'VARCHAR', - 'is_nullable' => 1, - 'size' => 255 - }, - 'charfield' => { - 'data_type' => 'CHAR', - 'is_nullable' => 1, - 'size' => 10 - }, -}; - - -my $type_info = DB2Test->schema->storage->columns_info_for('artist'); -is_deeply($type_info, $test_type_info, 'columns_info_for - column data types'); - - - -# clean up our mess -$dbh->do("DROP TABLE artist"); - diff --git a/t/run/14mssql.tl b/t/run/14mssql.tl deleted file mode 100644 index f21d9e2..0000000 --- a/t/run/14mssql.tl +++ /dev/null @@ -1,49 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/}; - -#warn "$dsn $user $pass"; - -plan skip_all => 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test' - unless ($dsn); - -plan tests => 4; - -$schema->compose_connection( 'MSSQLTest' => $dsn, $user, $pass ); - -my $dbh = MSSQLTest->schema->storage->dbh; - -$dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL - DROP TABLE artist"); - -$dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(255));"); - -MSSQLTest::Artist->load_components('PK::Auto::MSSQL'); - -# Test PK -my $new = MSSQLTest::Artist->create( { name => 'foo' } ); -ok($new->artistid, "Auto-PK worked"); - -# Test LIMIT -for (1..6) { - MSSQLTest::Artist->create( { name => 'Artist ' . $_ } ); -} - -my $it = MSSQLTest::Artist->search( { }, - { rows => 3, - offset => 2, - order_by => 'artistid' - } -); - -is( $it->count, 3, "LIMIT count ok" ); -ok( $it->next->name, "iterator->next ok" ); -$it->next; -$it->next; -is( $it->next, undef, "next past end of resultset ok" ); - diff --git a/t/run/15limit.tl b/t/run/15limit.tl deleted file mode 100644 index 98d3b64..0000000 --- a/t/run/15limit.tl +++ /dev/null @@ -1,70 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -BEGIN { - eval "use DBD::SQLite"; - plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 9); -} - -# test LIMIT -my $it = $schema->resultset("CD")->search( {}, - { rows => 3, - order_by => 'title' } -); -is( $it->count, 3, "count ok" ); -is( $it->next->title, "Caterwaulin' Blues", "iterator->next ok" ); -$it->next; -$it->next; -is( $it->next, undef, "next past end of resultset ok" ); - -# test OFFSET -my @cds = $schema->resultset("CD")->search( {}, - { rows => 2, - offset => 2, - order_by => 'year' } -); -is( $cds[0]->title, "Spoonful of bees", "offset ok" ); - -# test software-based limiting -$it = $schema->resultset("CD")->search( {}, - { rows => 3, - software_limit => 1, - order_by => 'title' } -); -is( $it->count, 3, "software limit count ok" ); -is( $it->next->title, "Caterwaulin' Blues", "software iterator->next ok" ); -$it->next; -$it->next; -is( $it->next, undef, "software next past end of resultset ok" ); - -@cds = $schema->resultset("CD")->search( {}, - { rows => 2, - offset => 2, - software_limit => 1, - order_by => 'year' } -); -is( $cds[0]->title, "Spoonful of bees", "software offset ok" ); - -# based on a failing criteria submitted by waswas -# requires SQL::Abstract >= 1.20 -$it = $schema->resultset("CD")->search( - { title => [ - -and => - { - -like => '%bees' - }, - { - -not_like => 'Forkful%' - } - ] - }, - { rows => 5 } -); -is( $it->count, 1, "complex abstract count ok" ); - diff --git a/t/run/16joins.tl b/t/run/16joins.tl deleted file mode 100644 index 069626a..0000000 --- a/t/run/16joins.tl +++ /dev/null @@ -1,281 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -use IO::File; - -BEGIN { - eval "use DBD::SQLite"; - plan $@ - ? ( skip_all => 'needs DBD::SQLite for testing' ) - : ( tests => 42 ); -} - -# figure out if we've got a version of sqlite that is older than 3.2.6, in -# which case COUNT(DISTINCT()) doesn't work -my $is_broken_sqlite = 0; -my ($sqlite_major_ver,$sqlite_minor_ver,$sqlite_patch_ver) = - split /\./, $schema->storage->dbh->get_info(18); -if( $schema->storage->dbh->get_info(17) eq 'SQLite' && - ( ($sqlite_major_ver < 3) || - ($sqlite_major_ver == 3 && $sqlite_minor_ver < 2) || - ($sqlite_major_ver == 3 && $sqlite_minor_ver == 2 && $sqlite_patch_ver < 6) ) ) { - $is_broken_sqlite = 1; -} - -# test the abstract join => SQL generator -my $sa = new DBIC::SQL::Abstract; - -my @j = ( - { child => 'person' }, - [ { father => 'person' }, { 'father.person_id' => 'child.father_id' }, ], - [ { mother => 'person' }, { 'mother.person_id' => 'child.mother_id' } ], -); -my $match = 'person child JOIN person father ON ( father.person_id = ' - . 'child.father_id ) JOIN person mother ON ( mother.person_id ' - . '= child.mother_id )' - ; -is( $sa->_recurse_from(@j), $match, 'join 1 ok' ); - -my @j2 = ( - { mother => 'person' }, - [ [ { child => 'person' }, - [ { father => 'person' }, - { 'father.person_id' => 'child.father_id' } - ] - ], - { 'mother.person_id' => 'child.mother_id' } - ], -); -$match = 'person mother JOIN (person child JOIN person father ON (' - . ' father.person_id = child.father_id )) ON ( mother.person_id = ' - . 'child.mother_id )' - ; -is( $sa->_recurse_from(@j2), $match, 'join 2 ok' ); - -my @j3 = ( - { child => 'person' }, - [ { father => 'person', -join_type => 'inner' }, { 'father.person_id' => 'child.father_id' }, ], - [ { mother => 'person', -join_type => 'inner' }, { 'mother.person_id' => 'child.mother_id' } ], -); -$match = 'person child INNER JOIN person father ON ( father.person_id = ' - . 'child.father_id ) INNER JOIN person mother ON ( mother.person_id ' - . '= child.mother_id )' - ; - -is( $sa->_recurse_from(@j3), $match, 'join 3 (inner join) ok'); - -my $rs = $schema->resultset("CD")->search( - { 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' }, - { from => [ { 'me' => 'cd' }, - [ - { artist => 'artist' }, - { 'me.artist' => 'artist.artistid' } - ] ] } - ); - -cmp_ok( $rs + 0, '==', 1, "Single record in resultset"); - -is($rs->first->title, 'Forkful of bees', 'Correct record returned'); - -$rs = $schema->resultset("CD")->search( - { 'year' => 2001, 'artist.name' => 'Caterwauler McCrae' }, - { join => 'artist' }); - -cmp_ok( $rs + 0, '==', 1, "Single record in resultset"); - -is($rs->first->title, 'Forkful of bees', 'Correct record returned'); - -$rs = $schema->resultset("CD")->search( - { 'artist.name' => 'We Are Goth', - 'liner_notes.notes' => 'Kill Yourself!' }, - { join => [ qw/artist liner_notes/ ] }); - -cmp_ok( $rs + 0, '==', 1, "Single record in resultset"); - -is($rs->first->title, 'Come Be Depressed With Us', 'Correct record returned'); - -# when using join attribute, make sure slice()ing all objects has same count as all() -$rs = $schema->resultset("CD")->search( - { 'artist' => 1 }, - { join => [qw/artist/], order_by => 'artist.name' } -); -cmp_ok( scalar $rs->all, '==', scalar $rs->slice(0, $rs->count - 1), 'slice() with join has same count as all()' ); - -$rs = $schema->resultset("Artist")->search( - { 'liner_notes.notes' => 'Kill Yourself!' }, - { join => { 'cds' => 'liner_notes' } }); - -cmp_ok( $rs->count, '==', 1, "Single record in resultset"); - -is($rs->first->name, 'We Are Goth', 'Correct record returned'); - -$rs = $schema->resultset("CD")->search( - { 'artist.name' => 'Caterwauler McCrae' }, - { prefetch => [ qw/artist liner_notes/ ], - order_by => 'me.cdid' }); - -cmp_ok($rs + 0, '==', 3, 'Correct number of records returned'); - -my $queries = 0; -$schema->storage->debugcb(sub { $queries++ }); - -$queries = 0; -$schema->storage->debug(1); - -my @cd = $rs->all; - -is($cd[0]->title, 'Spoonful of bees', 'First record returned ok'); - -ok(!defined $cd[0]->liner_notes, 'No prefetch for NULL LEFT join'); - -is($cd[1]->{_relationship_data}{liner_notes}->notes, 'Buy Whiskey!', 'Prefetch for present LEFT JOIN'); - -is(ref $cd[1]->liner_notes, 'DBICTest::LinerNotes', 'Prefetch returns correct class'); - -is($cd[2]->{_inflated_column}{artist}->name, 'Caterwauler McCrae', 'Prefetch on parent object ok'); - -is($queries, 1, 'prefetch ran only 1 select statement'); - -$schema->storage->debug(0); - -# test for partial prefetch via columns attr -my $cd = $schema->resultset('CD')->find(1, - { - columns => [qw/title artist.name/], - join => { 'artist' => {} } - } -); -ok(eval { $cd->artist->name eq 'Caterwauler McCrae' }, 'single related column prefetched'); - -# start test for nested prefetch SELECT count -$queries = 0; -$schema->storage->debug(1); - -$rs = $schema->resultset('Tag')->search( - {}, - { - prefetch => { cd => 'artist' } - } -); - -my $tag = $rs->first; - -is( $tag->cd->title, 'Spoonful of bees', 'step 1 ok for nested prefetch' ); - -is( $tag->cd->artist->name, 'Caterwauler McCrae', 'step 2 ok for nested prefetch'); - -# count the SELECTs -#$selects++ if /SELECT(?!.*WHERE 1=0.*)/; -is($queries, 1, 'nested prefetch ran exactly 1 select statement (excluding column_info)'); - -$queries = 0; - -$cd = $schema->resultset('CD')->find(1, { prefetch => 'artist' }); - -is($cd->{_inflated_column}{artist}->name, 'Caterwauler McCrae', 'artist prefetched correctly on find'); - -is($queries, 1, 'find with prefetch ran exactly 1 select statement (excluding column_info)'); - -$schema->storage->debug(0); - -$rs = $schema->resultset('Tag')->search( - {}, - { - join => { cd => 'artist' }, - prefetch => { cd => 'artist' } - } -); - -cmp_ok( $rs->count, '>=', 0, 'nested prefetch does not duplicate joins' ); - -my ($artist) = $schema->resultset("Artist")->search({ 'cds.year' => 2001 }, - { order_by => 'artistid DESC', join => 'cds' }); - -is($artist->name, 'Random Boy Band', "Join search by object ok"); - -my @cds = $schema->resultset("CD")->search({ 'liner_notes.notes' => 'Buy Merch!' }, - { join => 'liner_notes' }); - -cmp_ok(scalar @cds, '==', 1, "Single CD retrieved via might_have"); - -is($cds[0]->title, "Generic Manufactured Singles", "Correct CD retrieved"); - -my @artists = $schema->resultset("Artist")->search({ 'tags.tag' => 'Shiny' }, - { join => { 'cds' => 'tags' } }); - -cmp_ok( @artists, '==', 2, "two-join search ok" ); - -$rs = $schema->resultset("CD")->search( - {}, - { group_by => [qw/ title me.cdid /] } -); - -SKIP: { - skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1 - if $is_broken_sqlite; - cmp_ok( $rs->count, '==', 5, "count() ok after group_by on main pk" ); -} - -cmp_ok( scalar $rs->all, '==', 5, "all() returns same count as count() after group_by on main pk" ); - -$rs = $schema->resultset("CD")->search( - {}, - { join => [qw/ artist /], group_by => [qw/ artist.name /] } -); - -SKIP: { - skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1 - if $is_broken_sqlite; - cmp_ok( $rs->count, '==', 3, "count() ok after group_by on related column" ); -} - -$rs = $schema->resultset("Artist")->search( - {}, - { join => [qw/ cds /], group_by => [qw/ me.name /], having =>{ 'MAX(cds.cdid)'=> \'< 5' } } -); - -cmp_ok( $rs->all, '==', 2, "results ok after group_by on related column with a having" ); - -$rs = $rs->search( undef, { having =>{ 'count(*)'=> \'> 2' }}); - -cmp_ok( $rs->all, '==', 1, "count() ok after group_by on related column with a having" ); - -$rs = $schema->resultset("Artist")->search( - { 'cds.title' => 'Spoonful of bees', - 'cds_2.title' => 'Forkful of bees' }, - { join => [ 'cds', 'cds' ] }); - -SKIP: { - skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 1 - if $is_broken_sqlite; - cmp_ok($rs->count, '==', 1, "single artist returned from multi-join"); -} - -is($rs->next->name, 'Caterwauler McCrae', "Correct artist returned"); - -$queries = 0; -$schema->storage->debug(1); - -my $tree_like = - $schema->resultset('TreeLike')->find(4, - { join => { parent => { parent => 'parent' } }, - prefetch => { parent => { parent => 'parent' } } }); - -is($tree_like->name, 'quux', 'Bottom of tree ok'); -$tree_like = $tree_like->parent; -is($tree_like->name, 'baz', 'First level up ok'); -$tree_like = $tree_like->parent; -is($tree_like->name, 'bar', 'Second level up ok'); -$tree_like = $tree_like->parent; -is($tree_like->name, 'foo', 'Third level up ok'); - -$schema->storage->debug(0); - -cmp_ok($queries, '==', 1, 'Only one query run'); - diff --git a/t/run/17join_count.tl b/t/run/17join_count.tl deleted file mode 100644 index 499b08f..0000000 --- a/t/run/17join_count.tl +++ /dev/null @@ -1,31 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -eval "use DBD::SQLite"; -plan skip_all => 'needs DBD::SQLite for testing' if $@; -plan tests => 4; - -cmp_ok($schema->resultset("CD")->count({ 'artist.name' => 'Caterwauler McCrae' }, - { join => 'artist' }), - '==', 3, 'Count by has_a ok'); - -cmp_ok($schema->resultset("CD")->count({ 'tags.tag' => 'Blue' }, { join => 'tags' }), - '==', 4, 'Count by has_many ok'); - -cmp_ok($schema->resultset("CD")->count( - { 'liner_notes.notes' => { '!=' => undef } }, - { join => 'liner_notes' }), - '==', 3, 'Count by might_have ok'); - -cmp_ok($schema->resultset("CD")->count( - { 'year' => { '>', 1998 }, 'tags.tag' => 'Cheesy', - 'liner_notes.notes' => { 'like' => 'Buy%' } }, - { join => [ qw/tags liner_notes/ ] } ), - '==', 2, "Mixed count ok"); - diff --git a/t/run/18self_referencial.tl b/t/run/18self_referencial.tl deleted file mode 100644 index 5759aca..0000000 --- a/t/run/18self_referencial.tl +++ /dev/null @@ -1,42 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -# this test will check to see if you can have 2 columns -# in the same class pointing at the same other class -# -# example: -# -# +---------+ +--------------+ -# | SelfRef | | SelfRefAlias | -# +---------+ 1-M +--------------+ -# | id |-------| self_ref | --+ -# | name | | alias | --+ -# +---------+ +--------------+ | -# /|\ | -# | | -# +--------------------------------+ -# -# see http://use.perl.org/~LTjake/journal/24876 for the -# issue with CDBI - -plan tests => 4; - -my $item = $schema->resultset("SelfRef")->find( 1 ); -is( $item->name, 'First', 'proper start item' ); - -my @aliases = $item->aliases; - -is( scalar @aliases, 1, 'proper number of aliases' ); - -my $orig = $aliases[ 0 ]->self_ref; -my $alias = $aliases[ 0 ]->alias; - -is( $orig->name, 'First', 'proper original' ); -is( $alias->name, 'Second', 'proper alias' ); - diff --git a/t/run/19uuid.tl b/t/run/19uuid.tl deleted file mode 100644 index d4800d9..0000000 --- a/t/run/19uuid.tl +++ /dev/null @@ -1,20 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -eval 'use Data::UUID ; 1' - or plan skip_all, 'Install Data::UUID run this test'; - -plan tests => 1; -DBICTest::Schema::Artist->load_components('UUIDColumns'); -DBICTest::Schema::Artist->uuid_columns('name'); -Class::C3->reinitialize(); - -my $artist = $schema->resultset("Artist")->create( { artistid => 100 } ); -like $artist->name, qr/[\w-]{36}/, 'got something like uuid'; - diff --git a/t/run/20unique.tl b/t/run/20unique.tl deleted file mode 100644 index 9d7634c..0000000 --- a/t/run/20unique.tl +++ /dev/null @@ -1,127 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 34; - -my $artistid = 1; -my $title = 'UNIQUE Constraint'; - -my $cd1 = $schema->resultset('CD')->find_or_create({ - artist => $artistid, - title => $title, - year => 2005, -}); - -my $cd2 = $schema->resultset('CD')->find( - { - artist => $artistid, - title => $title, - }, - { key => 'artist_title' } -); - -is($cd2->get_column('artist'), $cd1->get_column('artist'), 'find by specific key: artist is correct'); -is($cd2->title, $cd1->title, 'title is correct'); -is($cd2->year, $cd1->year, 'year is correct'); - -my $cd3 = $schema->resultset('CD')->find($artistid, $title, { key => 'artist_title' }); - -is($cd3->get_column('artist'), $cd1->get_column('artist'), 'find by specific key, ordered columns: artist is correct'); -is($cd3->title, $cd1->title, 'title is correct'); -is($cd3->year, $cd1->year, 'year is correct'); - -my $cd4 = $schema->resultset('CD')->update_or_create( - { - artist => $artistid, - title => $title, - year => 2007, - }, -); - -ok(! $cd4->is_changed, 'update_or_create without key: row is clean'); -is($cd4->cdid, $cd2->cdid, 'cdid is correct'); -is($cd4->get_column('artist'), $cd2->get_column('artist'), 'artist is correct'); -is($cd4->title, $cd2->title, 'title is correct'); -is($cd4->year, 2007, 'updated year is correct'); - -my $cd5 = $schema->resultset('CD')->update_or_create( - { - artist => $artistid, - title => $title, - year => 2007, - }, - { key => 'artist_title' } -); - -ok(! $cd5->is_changed, 'update_or_create by specific key: row is clean'); -is($cd5->cdid, $cd2->cdid, 'cdid is correct'); -is($cd5->get_column('artist'), $cd2->get_column('artist'), 'artist is correct'); -is($cd5->title, $cd2->title, 'title is correct'); -is($cd5->year, 2007, 'updated year is correct'); - -my $cd6 = $schema->resultset('CD')->update_or_create( - { - cdid => $cd2->cdid, - artist => 1, - title => $cd2->title, - year => 2005, - }, - { key => 'primary' } -); - -ok(! $cd6->is_changed, 'update_or_create by PK: row is clean'); -is($cd6->cdid, $cd2->cdid, 'cdid is correct'); -is($cd6->get_column('artist'), $cd2->get_column('artist'), 'artist is correct'); -is($cd6->title, $cd2->title, 'title is correct'); -is($cd6->year, 2005, 'updated year is correct'); - -my $cd7 = $schema->resultset('CD')->find_or_create( - { - artist => $artistid, - title => $title, - year => 2010, - }, - { key => 'artist_title' } -); - -is($cd7->cdid, $cd1->cdid, 'find_or_create by specific key: cdid is correct'); -is($cd7->get_column('artist'), $cd1->get_column('artist'), 'artist is correct'); -is($cd7->title, $cd1->title, 'title is correct'); -is($cd7->year, $cd1->year, 'year is correct'); - -my $artist = $schema->resultset('Artist')->find($artistid); -my $cd8 = $artist->find_or_create_related('cds', - { - artist => $artistid, - title => $title, - year => 2020, - }, - { key => 'artist_title' } -); - -is($cd8->cdid, $cd1->cdid, 'find_or_create related by specific key: cdid is correct'); -is($cd8->get_column('artist'), $cd1->get_column('artist'), 'artist is correct'); -is($cd8->title, $cd1->title, 'title is correct'); -is($cd8->year, $cd1->year, 'year is correct'); - -my $cd9 = $artist->update_or_create_related('cds', - { - artist => $artistid, - title => $title, - year => 2021, - }, - { key => 'artist_title' } -); - -ok(! $cd9->is_changed, 'update_or_create by specific key: row is clean'); -is($cd9->cdid, $cd1->cdid, 'cdid is correct'); -is($cd9->get_column('artist'), $cd1->get_column('artist'), 'artist is correct'); -is($cd9->title, $cd1->title, 'title is correct'); -is($cd9->year, 2021, 'year is correct'); - diff --git a/t/run/21transactions.tl b/t/run/21transactions.tl deleted file mode 100644 index fe3c453..0000000 --- a/t/run/21transactions.tl +++ /dev/null @@ -1,179 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 39; - -my $code = sub { - my ($artist, @cd_titles) = @_; - - $artist->create_related('cds', { - title => $_, - year => 2006, - }) foreach (@cd_titles); - - return $artist->cds->all; -}; - -# Test checking of parameters -{ - eval { - (ref $schema)->txn_do(sub{}); - }; - like($@, qr/class method/, '$self parameter check ok'); - eval { - $schema->txn_do(''); - }; - like($@, qr/must be a CODE reference/, '$coderef parameter check ok'); -} - -# Test successful txn_do() - scalar context -{ - my @titles = map {'txn_do test CD ' . $_} (1..5); - my $artist = $schema->resultset('Artist')->find(1); - my $count_before = $artist->cds->count; - my $count_after = $schema->txn_do($code, $artist, @titles); - is($count_after, $count_before+5, 'successful txn added 5 cds'); - is($artist->cds({ - title => "txn_do test CD $_", - })->first->year, 2006, "new CD $_ year correct") for (1..5); -} - -# Test successful txn_do() - list context -{ - my @titles = map {'txn_do test CD ' . $_} (6..10); - my $artist = $schema->resultset('Artist')->find(1); - my $count_before = $artist->cds->count; - my @cds = $schema->txn_do($code, $artist, @titles); - is(scalar @cds, $count_before+5, 'added 5 CDs and returned in list context'); - is($artist->cds({ - title => "txn_do test CD $_", - })->first->year, 2006, "new CD $_ year correct") for (6..10); -} - -# Test nested successful txn_do() -{ - my $nested_code = sub { - my ($schema, $artist, $code) = @_; - - my @titles1 = map {'nested txn_do test CD ' . $_} (1..5); - my @titles2 = map {'nested txn_do test CD ' . $_} (6..10); - - $schema->txn_do($code, $artist, @titles1); - $schema->txn_do($code, $artist, @titles2); - }; - - my $artist = $schema->resultset('Artist')->find(2); - my $count_before = $artist->cds->count; - - eval { - $schema->txn_do($nested_code, $schema, $artist, $code); - }; - - my $error = $@; - - ok(!$error, 'nested txn_do succeeded'); - is($artist->cds({ - title => 'nested txn_do test CD '.$_, - })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10); - is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs'); -} - -my $fail_code = sub { - my ($artist) = @_; - $artist->create_related('cds', { - title => 'this should not exist', - year => 2005, - }); - die "the sky is falling"; -}; - -# Test failed txn_do() -{ - my $artist = $schema->resultset('Artist')->find(3); - - eval { - $schema->txn_do($fail_code, $artist); - }; - - my $error = $@; - - like($error, qr/the sky is falling/, 'failed txn_do threw an exception'); - my $cd = $artist->cds({ - title => 'this should not exist', - year => 2005, - })->first; - ok(!defined($cd), q{failed txn_do didn't change the cds table}); -} - -# Test failed txn_do() with failed rollback -{ - my $artist = $schema->resultset('Artist')->find(3); - - # Force txn_rollback() to throw an exception - no warnings 'redefine'; - local *{"DBIx::Class::Schema::txn_rollback"} = sub{die 'FAILED'}; - - eval { - $schema->txn_do($fail_code, $artist); - }; - - my $error = $@; - - like($error, qr/Rollback failed/, 'failed txn_do with a failed '. - 'txn_rollback threw a rollback exception'); - like($error, qr/the sky is falling/, 'failed txn_do with a failed '. - 'txn_rollback included the original exception'); - - my $cd = $artist->cds({ - title => 'this should not exist', - year => 2005, - })->first; - isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }. - q{changed the cds table}); - $cd->delete; # Rollback failed - $cd = $artist->cds({ - title => 'this should not exist', - year => 2005, - })->first; - ok(!defined($cd), q{deleted the failed txn's cd}); - $schema->storage->{transaction_depth} = 0; # Must reset this or further tests - # will fail -} - -# Test nested failed txn_do() -{ - my $nested_fail_code = sub { - my ($schema, $artist, $code1, $code2) = @_; - - my @titles = map {'nested txn_do test CD ' . $_} (1..5); - - $schema->txn_do($code1, $artist, @titles); # successful txn - $schema->txn_do($code2, $artist); # failed txn - }; - - my $artist = $schema->resultset('Artist')->find(3); - - eval { - $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code); - }; - - my $error = $@; - - like($error, qr/the sky is falling/, 'nested failed txn_do threw exception'); - ok(!defined($artist->cds({ - title => 'nested txn_do test CD '.$_, - year => 2006, - })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5); - my $cd = $artist->cds({ - title => 'this should not exist', - year => 2005, - })->first; - ok(!defined($cd), q{failed txn_do didn't add failed txn's cd}); -} - diff --git a/t/run/22cascade_copy.tl b/t/run/22cascade_copy.tl deleted file mode 100644 index e5048a1..0000000 --- a/t/run/22cascade_copy.tl +++ /dev/null @@ -1,33 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 4; -my $artist = $schema->resultset('Artist')->find(1); -my $artist_cds = $artist->search_related('cds'); - -my $cover_band; - -{ - no warnings 'redefine'; - local *DBICTest::Artist::result_source_instance = \&DBICTest::Schema::Artist::result_source_instance; - - $cover_band = $artist->copy; -} - -my $cover_cds = $cover_band->search_related('cds'); -cmp_ok($cover_band->id, '!=', $artist->id, 'ok got new column id...'); -is($cover_cds->count, $artist_cds->count, 'duplicated rows count ok'); - -#check multi-keyed -cmp_ok($cover_band->search_related('twokeys')->count, '>', 0, 'duplicated multiPK ok'); - -#and check copying a few relations away -cmp_ok($cover_cds->search_related('tags')->count, '==', - $artist_cds->search_related('tags')->count , 'duplicated count ok'); - diff --git a/t/run/23cache.tl b/t/run/23cache.tl deleted file mode 100644 index a3c94c0..0000000 --- a/t/run/23cache.tl +++ /dev/null @@ -1,181 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -my $queries; -$schema->storage->debugcb( sub{ $queries++ } ); - -eval "use DBD::SQLite"; -plan skip_all => 'needs DBD::SQLite for testing' if $@; -plan tests => 22; - -my $rs = $schema->resultset("Artist")->search( - { artistid => 1 } -); - -my $artist = $rs->first; - -ok( !defined($rs->get_cache), 'cache is not populated without cache attribute' ); - -$rs = $schema->resultset('Artist')->search( undef, { cache => 1 } ); -my $artists = [ $rs->all ]; - -is( scalar @{$rs->get_cache}, 3, 'all() populates cache for search with cache attribute' ); - -$rs->clear_cache; - -ok( !defined($rs->get_cache), 'clear_cache is functional' ); - -$rs->next; - -is( scalar @{$rs->get_cache}, 3, 'next() populates cache for search with cache attribute' ); - -pop( @$artists ); -$rs->set_cache( $artists ); - -is( scalar @{$rs->get_cache}, 2, 'set_cache() is functional' ); - -$cd = $schema->resultset('CD')->find(1); - -$rs->clear_cache; - -$queries = 0; -$schema->storage->debug(1); - -$rs = $schema->resultset('Artist')->search( undef, { cache => 1 } ); -while( $artist = $rs->next ) {} -$artist = $rs->first(); - -is( $queries, 1, 'revisiting a row does not issue a query when cache => 1' ); - -$schema->storage->debug(0); - -my @a = $schema->resultset("Artist")->search( - { }, - { - join => [ qw/ cds /], - prefetch => [qw/ cds /], - } -); - -is(scalar @a, 3, 'artist with cds: count parent objects'); - -$rs = $schema->resultset("Artist")->search( - { 'artistid' => 1 }, - { - join => [ qw/ cds /], - prefetch => [qw/ cds /], - } -); - -use Data::Dumper; $Data::Dumper::Deparse = 1; - -# start test for prefetch SELECT count -$queries = 0; -$schema->storage->debug(1); - -$artist = $rs->first; -$rs->reset(); - -# make sure artist contains a related resultset for cds -is( ref $artist->{related_resultsets}->{cds}, 'DBIx::Class::ResultSet', 'artist has a related_resultset for cds' ); - -# check if $artist->cds->get_cache is populated -is( scalar @{$artist->cds->get_cache}, 3, 'cache for artist->cds contains correct number of records'); - -# ensure that $artist->cds returns correct number of objects -is( scalar ($artist->cds), 3, 'artist->cds returns correct number of objects' ); - -# ensure that $artist->cds->count returns correct value -is( $artist->cds->count, 3, 'artist->cds->count returns correct value' ); - -# ensure that $artist->count_related('cds') returns correct value -is( $artist->count_related('cds'), 3, 'artist->count_related returns correct value' ); - -is($queries, 1, 'only one SQL statement executed'); - -$schema->storage->debug(0); - -# make sure related_resultset is deleted after object is updated -$artist->set_column('name', 'New Name'); -$artist->update(); - -is( scalar keys %{$artist->{related_resultsets}}, 0, 'related resultsets deleted after update' ); - -# todo: make sure caching works with nested prefetch e.g. $artist->cds->tracks -$rs = $schema->resultset("Artist")->search( - { artistid => 1 }, - { - join => { cds => 'tags' }, - prefetch => { - cds => 'tags' - }, - } -); -{ -my $artist_count_before = $schema->resultset('Artist')->count; -$schema->resultset("Artist")->create({artistid=>4,name=>qq{Humoungous Hamsters}}); -is($schema->resultset('Artist')->count, $artist_count_before + 1, 'count() reflects new artist'); -my $artist = $schema->resultset("Artist")->search( - { artistid => 4 },{prefetch=>[qw/cds/]} -)->first; - -is($artist->cds, 0, 'No cds for this artist'); -} - -# SELECT count for nested has_many prefetch -$queries = 0; -$schema->storage->debug(1); - -$artist = ($rs->all)[0]; - -is($queries, 1, 'only one SQL statement executed'); - -$schema->storage->debug(0); - -my @objs; -#$artist = $rs->find(1); - -$queries = 0; -$schema->storage->debug(1); - -my $cds = $artist->cds; -my $tags = $cds->next->tags; -while( my $tag = $tags->next ) { - push @objs, $tag->tagid; #warn "tag:", $tag->ID, " => ", $tag->tag; -} - -is_deeply( \@objs, [ 3 ], 'first cd has correct tags' ); - -$tags = $cds->next->tags; -@objs = (); -while( my $tag = $tags->next ) { - push @objs, $tag->id; #warn "tag: ", $tag->ID; -} - -is_deeply( \@objs, [ 2, 5, 8 ], 'second cd has correct tags' ); - -is( $queries, 0, 'no additional SQL statements while checking nested data' ); - -# start test for prefetch SELECT count -$queries = 0; - -$artist = $schema->resultset('Artist')->find(1, { prefetch => [qw/cds/] }); - -is( $queries, 1, 'only one select statement on find with inline has_many prefetch' ); - -# start test for prefetch SELECT count -$queries = 0; - -$rs = $schema->resultset('Artist')->search(undef, { prefetch => [qw/cds/] }); -$artist = $rs->find(1); - -is( $queries, 1, 'only one select statement on find with has_many prefetch on resultset' ); - -$schema->storage->debug(0); - diff --git a/t/run/24serialize.tl b/t/run/24serialize.tl deleted file mode 100644 index d79acba..0000000 --- a/t/run/24serialize.tl +++ /dev/null @@ -1,16 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; -use Storable; - -my $schema = DBICTest::init_schema(); - -plan tests => 1; - -my $artist = $schema->resultset('Artist')->find(1); -my $copy = eval { Storable::dclone($artist) }; -is_deeply($copy, $artist, 'serialize row object works'); - diff --git a/t/run/25utf8.tl b/t/run/25utf8.tl deleted file mode 100644 index c0f39ed..0000000 --- a/t/run/25utf8.tl +++ /dev/null @@ -1,27 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -eval 'use Encode ; 1' - or plan skip_all => 'Install Encode run this test'; - -plan tests => 2; - -DBICTest::Schema::Artist->load_components('UTF8Columns'); -DBICTest::Schema::Artist->utf8_columns('name'); -Class::C3->reinitialize(); - -my $artist = $schema->resultset("Artist")->create( { name => 'uni' } ); -ok( Encode::is_utf8( $artist->name ), 'got name with utf8 flag' ); - -my $utf8_char = 'uniuni'; -Encode::_utf8_on($utf8_char); -$artist->name($utf8_char); -ok( !Encode::is_utf8( $artist->{_column_data}->{name} ), - 'store utf8 less chars' ); - diff --git a/t/run/26might_have.tl b/t/run/26might_have.tl deleted file mode 100644 index 1d4af78..0000000 --- a/t/run/26might_have.tl +++ /dev/null @@ -1,47 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -my $queries; -#$schema->storage->debugfh(IO::File->new('t/var/temp.trace', 'w')); -$schema->storage->debugcb( sub{ $queries++ } ); - -eval "use DBD::SQLite"; -plan skip_all => 'needs DBD::SQLite for testing' if $@; -plan tests => 2; - - -my $cd = $schema->resultset("CD")->find(1); -$cd->title('test'); - -# SELECT count -$queries = 0; -$schema->storage->debug(1); - -$cd->update; - -is($queries, 1, 'liner_notes (might_have) not prefetched - do not load -liner_notes on update'); - -$schema->storage->debug(0); - - -my $cd2 = $schema->resultset("CD")->find(2, {prefetch => 'liner_notes'}); -$cd2->title('test2'); - -# SELECT count -$queries = 0; -$schema->storage->debug(1); - -$cd2->update; - -is($queries, 1, 'liner_notes (might_have) prefetched - do not load -liner_notes on update'); - -$schema->storage->debug(0); - diff --git a/t/run/27ordered.tl b/t/run/27ordered.tl deleted file mode 100644 index 7a4847e..0000000 --- a/t/run/27ordered.tl +++ /dev/null @@ -1,104 +0,0 @@ -# vim: filetype=perl -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 321; - -my $employees = $schema->resultset('Employee'); -$employees->delete(); - -foreach (1..5) { - $employees->create({ name=>'temp' }); -} -$employees = $employees->search(undef,{order_by=>'position'}); -ok( check_rs($employees), "intial positions" ); - -hammer_rs( $employees ); - -DBICTest::Employee->grouping_column('group_id'); -$employees->delete(); -foreach my $group_id (1..3) { - foreach (1..6) { - $employees->create({ name=>'temp', group_id=>$group_id }); - } -} -$employees = $employees->search(undef,{order_by=>'group_id,position'}); - -foreach my $group_id (1..3) { - my $group_employees = $employees->search({group_id=>$group_id}); - $group_employees->all(); - ok( check_rs($group_employees), "group intial positions" ); - hammer_rs( $group_employees ); -} - -sub hammer_rs { - my $rs = shift; - my $employee; - my $count = $rs->count(); - my $position_column = $rs->result_class->position_column(); - - foreach my $position (1..$count) { - - ($row) = $rs->search({ $position_column=>$position })->all(); - $row->move_previous(); - ok( check_rs($rs), "move_previous( $position )" ); - - ($row) = $rs->search({ $position_column=>$position })->all(); - $row->move_next(); - ok( check_rs($rs), "move_next( $position )" ); - - ($row) = $rs->search({ $position_column=>$position })->all(); - $row->move_first(); - ok( check_rs($rs), "move_first( $position )" ); - - ($row) = $rs->search({ $position_column=>$position })->all(); - $row->move_last(); - ok( check_rs($rs), "move_last( $position )" ); - - foreach my $to_position (1..$count) { - ($row) = $rs->search({ $position_column=>$position })->all(); - $row->move_to($to_position); - ok( check_rs($rs), "move_to( $position => $to_position )" ); - } - - ($row) = $rs->search({ position=>$position })->all(); - if ($position==1) { - ok( !$row->previous_sibling(), 'no previous sibling' ); - ok( !$row->first_sibling(), 'no first sibling' ); - } - else { - ok( $row->previous_sibling(), 'previous sibling' ); - ok( $row->first_sibling(), 'first sibling' ); - } - if ($position==$count) { - ok( !$row->next_sibling(), 'no next sibling' ); - ok( !$row->last_sibling(), 'no last sibling' ); - } - else { - ok( $row->next_sibling(), 'next sibling' ); - ok( $row->last_sibling(), 'last sibling' ); - } - - } -} - -sub check_rs { - my( $rs ) = @_; - $rs->reset(); - my $position_column = $rs->result_class->position_column(); - my $expected_position = 0; - while (my $row = $rs->next()) { - $expected_position ++; - if ($row->get_column($position_column)!=$expected_position) { - return 0; - } - } - return 1; -} - diff --git a/t/run/28result_set_column.tl b/t/run/28result_set_column.tl deleted file mode 100644 index c062a23..0000000 --- a/t/run/28result_set_column.tl +++ /dev/null @@ -1,43 +0,0 @@ -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -plan tests => 8; - -my $rs = $cd = $schema->resultset("CD")->search({}); - -my $rs_title = $rs->get_column('title'); -my $rs_year = $rs->get_column('year'); - -is($rs_title->next, 'Spoonful of bees', "next okay"); - -my @all = $rs_title->all; -cmp_ok(scalar @all, '==', 5, "five titles returned"); - -cmp_ok($rs_year->max, '==', 2001, "max okay for year"); -is($rs_title->min, 'Caterwaulin\' Blues', "min okay for title"); - -cmp_ok($rs_year->sum, '==', 9996, "three artists returned"); - -my $psrs = $schema->resultset('CD')->search({}, - { - '+select' => \'COUNT(*)', - '+as' => 'count' - } -); -ok(defined($psrs->get_column('count')), '+select/+as count'); - -$psrs = $schema->resultset('CD')->search({}, - { - '+select' => [ \'COUNT(*)', 'title' ], - '+as' => [ 'count', 'addedtitle' ] - } -); -ok(defined($psrs->get_column('count')), '+select/+as arrayref count'); -ok(defined($psrs->get_column('addedtitle')), '+select/+as title'); - diff --git a/t/run/29dbicadmin.tl b/t/run/29dbicadmin.tl deleted file mode 100644 index a411eb7..0000000 --- a/t/run/29dbicadmin.tl +++ /dev/null @@ -1,41 +0,0 @@ -# vim: filetype=perl -use strict; -use warnings; - -use Test::More; -use lib qw(t/lib); -use DBICTest; - -my $schema = DBICTest::init_schema(); - -eval 'require JSON'; -plan skip_all => 'Install JSON to run this test' if ($@); - -eval 'require Text::CSV_XS'; -if ($@) { - eval 'require Text::CSV_PP'; - plan skip_all => 'Install Text::CSV_XS or Text::CSV_PP to run this test' if ($@); -} - -plan tests => 5; - -my $employees = $schema->resultset('Employee'); -my $cmd = qq|script/dbicadmin --schema=DBICTest::Schema --class=Employee --tlibs --connect='["dbi:SQLite:dbname=t/var/DBIxClass.db","",""]' --force --tlibs|; - -`$cmd --op=insert --set='{name:"Matt"}'`; -ok( ($employees->count()==1), 'insert count' ); - -my $employee = $employees->find(1); -ok( ($employee->name() eq 'Matt'), 'insert valid' ); - -`$cmd --op=update --set='{name:"Trout"}'`; -$employee = $employees->find(1); -ok( ($employee->name() eq 'Trout'), 'update' ); - -`$cmd --op=insert --set='{name:"Aran"}'`; -my $data = `$cmd --op=select --attrs='{order_by:"name"}'`; -ok( ($data=~/Aran.*Trout/s), 'select with attrs' ); - -`$cmd --op=delete --where='{name:"Trout"}'`; -ok( ($employees->count()==1), 'delete' ); - diff --git a/t/run/29inflate_datetime.tl b/t/run/29inflate_datetime.tl deleted file mode 100644 index 0efc45a..0000000 --- a/t/run/29inflate_datetime.tl +++ /dev/null @@ -1,18 +0,0 @@ -sub run_tests { -my $schema = shift; - -eval { require DateTime::Format::MySQL }; -plan skip_all => "Need DateTime::Format::MySQL for inflation tests" if $@; - -plan tests => 2; - -# inflation test -my $event = $schema->resultset("Event")->find(1); - -isa_ok($event->starts_at, 'DateTime', 'DateTime returned'); - -is($event->starts_at, '2006-04-25T22:24:33', 'Correct date/time'); - -} - -1; diff --git a/t/run/30ensure_class_loaded.tl b/t/run/30ensure_class_loaded.tl deleted file mode 100644 index 8602565..0000000 --- a/t/run/30ensure_class_loaded.tl +++ /dev/null @@ -1,40 +0,0 @@ -use Class::Inspector; - -BEGIN { - package TestPackage::A; - sub some_method {} -} - -sub run_tests { - -my $schema = shift; -plan tests => 6; - -ok(Class::Inspector->loaded('TestPackage::A'), - 'anon. package exists'); -eval { - $schema->ensure_class_loaded('TestPackage::A'); -}; - -ok(!$@, 'ensure_class_loaded detected an anon. class'); - -eval { - $schema->ensure_class_loaded('FakePackage::B'); -}; - -like($@, qr/Can't locate/, - 'ensure_class_loaded threw exception for nonexistent class'); - -ok(!Class::Inspector->loaded('DBICTest::FakeComponent'), - 'DBICTest::FakeComponent not loaded yet'); - -eval { - $schema->ensure_class_loaded('DBICTest::FakeComponent'); -}; - -ok(!$@, 'ensure_class_loaded detected an existing but non-loaded class'); -ok(Class::Inspector->loaded('DBICTest::FakeComponent'), - 'DBICTest::FakeComponent now loaded'); -} - -1; diff --git a/t/run/30join_torture.tl b/t/run/30join_torture.tl deleted file mode 100644 index 181a94e..0000000 --- a/t/run/30join_torture.tl +++ /dev/null @@ -1,25 +0,0 @@ -sub run_tests { -my $schema = shift; - -plan tests => 4; - -my $rs1 = $schema->resultset("Artist")->search({ 'tags.tag' => 'Blue' }, { join => {'cds' => 'tracks'}, prefetch => {'cds' => 'tags'} }); -my @artists = $rs1->all; -cmp_ok(@artists, '==', 1, "Two artists returned"); - -my $rs2 = $rs1->search({ artistid => '1' }, { join => {'cds' => {'cd_to_producer' => 'producer'} } }); -my $rs3 = $rs2->search_related('cds')->search({'cds.title' => 'Forkful of bees'}); -cmp_ok($rs3->count, '==', 3, "Three artists returned"); - -my $rs4 = $schema->resultset("CD")->search({ 'artist.artistid' => '1' }, { join => ['tracks', 'artist'], prefetch => 'artist' }); -my @rs4_results = $rs4->all; - - -is($rs4_results[0]->cdid, 1, "correct artist returned"); - -my $rs5 = $rs4->search({'tracks.title' => 'Sticky Honey'}); -is($rs5->count, 1, "search without using previous joins okay"); - -} - -1;