X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F71mysql.t;h=ef2c7de6c38805ba103788a0e373f6f46b1a1ee8;hb=c1f3f2e8a79c6a4081c9949fa30da09d18d64d3b;hp=18a44b03ec3b2ecc2d4f552d7687e06aca737207;hpb=f98120e4b249787a84b7d19819d9bda9e53d3711;p=dbsrgits%2FDBIx-Class.git diff --git a/t/71mysql.t b/t/71mysql.t index 18a44b0..ef2c7de 100644 --- a/t/71mysql.t +++ b/t/71mysql.t @@ -3,19 +3,24 @@ use warnings; use Test::More; use Test::Exception; +use Test::Warn; + +use DBI::Const::GetInfoType; +use Scalar::Util qw/weaken/; +use DBIx::Class::Optional::Dependencies (); + use lib qw(t/lib); use DBICTest; -use DBI::Const::GetInfoType; -use DBIC::SqlMakerTest; -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/}; +plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mysql') + unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mysql'); -#warn "$dsn $user $pass"; +my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/}; plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test' unless ($dsn && $user); -my $schema = DBICTest::Schema->connect($dsn, $user, $pass); +my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { quote_names => 1 }); my $dbh = $schema->storage->dbh; @@ -45,7 +50,7 @@ $dbh->do("CREATE TABLE books (id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, so #'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', ''); -# make sure sqlt_type overrides work (::Storage::DBI::mysql does this) +# make sure sqlt_type overrides work (::Storage::DBI::mysql does this) { my $schema = DBICTest::Schema->connect($dsn, $user, $pass); @@ -137,7 +142,7 @@ $schema->populate ('BooksInLibrary', [ ]); # -# try a distinct + prefetch on tables with identically named columns +# try a distinct + prefetch on tables with identically named columns # (mysql doesn't seem to like subqueries with equally named columns) # @@ -166,15 +171,10 @@ $schema->populate ('BooksInLibrary', [ } SKIP: { - my $mysql_version = $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ); - skip "Cannot determine MySQL server version", 1 if !$mysql_version; - - my ($v1, $v2, $v3) = $mysql_version =~ /^(\d+)\.(\d+)(?:\.(\d+))?/; - skip "Cannot determine MySQL server version", 1 if !$v1 || !defined($v2); - - $v3 ||= 0; + my $norm_version = $schema->storage->_server_info->{normalized_dbms_version} + or skip "Cannot determine MySQL server version", 1; - if( ($v1 < 5) || ($v1 == 5 && $v2 == 0 && $v3 <= 3) ) { + if ($norm_version < 5.000003_01) { $test_type_info->{charfield}->{data_type} = 'VARCHAR'; } @@ -198,43 +198,6 @@ lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die'; my $cd = $rs->next; is ($cd->artist->name, $artist->name, 'Prefetched artist'); }, 'join does not throw (mysql 3 test)'; - - # induce a jointype override, make sure it works even if we don't have mysql3 - local $schema->storage->sql_maker->{_default_jointype} = 'inner'; - is_same_sql_bind ( - $rs->as_query, - '( - SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, - artist.artistid, artist.name, artist.rank, artist.charfield - FROM cd me - INNER JOIN artist artist ON artist.artistid = me.artist - )', - [], - 'overriden default join type works', - ); -} - -{ - # Test support for straight joins - my $cdsrc = $schema->source('CD'); - my $artrel_info = $cdsrc->relationship_info ('artist'); - $cdsrc->add_relationship( - 'straight_artist', - $artrel_info->{class}, - $artrel_info->{cond}, - { %{$artrel_info->{attrs}}, join_type => 'straight' }, - ); - is_same_sql_bind ( - $cdsrc->resultset->search({}, { prefetch => 'straight_artist' })->as_query, - '( - SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, - straight_artist.artistid, straight_artist.name, straight_artist.rank, straight_artist.charfield - FROM cd me - STRAIGHT_JOIN artist straight_artist ON straight_artist.artistid = me.artist - )', - [], - 'straight joins correctly supported for mysql' - ); } ## Can we properly deal with the null search problem? @@ -264,7 +227,7 @@ NULLINSEARCH: { my $artist = $artist2_rs->single; - is $artist => undef + is $artist => undef, => 'Nothing Found!'; } @@ -292,8 +255,53 @@ NULLINSEARCH: { join => 'books', group_by => [ 'me.id', 'books.id' ] })->count(); }, 'count on grouped columns with the same name does not throw'); +} + +# a more contrived^Wcomplicated self-referential double-subquery test +{ + my $rs = $schema->resultset('Artist')->search({ name => { -like => 'baby_%' } }); + + $rs->populate([map { [$_] } ('name', map { "baby_$_" } (1..10) ) ]); + + my ($count_sql, @count_bind) = @${$rs->count_rs->as_query}; + + my $complex_rs = $schema->resultset('Artist')->search( + { artistid => { + -in => $rs->get_column('artistid') + ->as_query + } }, + ); + + $complex_rs->update({ name => \[ "CONCAT( `name`, '_bell_out_of_', $count_sql )", @count_bind ] }); + for (1..10) { + is ( + $schema->resultset('Artist')->search({ name => "baby_${_}_bell_out_of_10" })->count, + 1, + "Correctly updated babybell $_", + ); + } + + is ($rs->count, 10, '10 artists present'); + + $schema->is_executed_querycount( sub { + $complex_rs->delete; + }, 1, 'One delete query fired' ); + is ($rs->count, 0, '10 Artists correctly deleted'); + + $rs->create({ + name => 'baby_with_cd', + cds => [ { title => 'babeeeeee', year => 2013 } ], + }); + is ($rs->count, 1, 'Artist with cd created'); + + $schema->is_executed_querycount( sub { + $schema->resultset('CD')->search_related('artist', + { 'artist.name' => { -like => 'baby_with_%' } } + )->delete; + }, 1, 'And one more delete query fired'); + is ($rs->count, 0, 'Artist with cd deleted'); } ZEROINSEARCH: { @@ -317,31 +325,40 @@ ZEROINSEARCH: { select => [ \ 'YEAR(year)' ], as => ['y'], distinct => 1, }); - is_deeply ( - [ sort ($rs->get_column ('y')->all) ], + my $y_rs = $rs->get_column ('y'); + + warnings_exist { is_deeply ( + [ sort ($y_rs->all) ], [ sort keys %$cds_per_year ], 'Years group successfully', - ); + ) } qr/ + \QUse of distinct => 1 while selecting anything other than a column \E + \Qdeclared on the primary ResultSource is deprecated\E + /x, 'deprecation warning'; + $rs->create ({ artist => 1, year => '0-1-1', title => 'Jesus Rap' }); is_deeply ( - [ sort $rs->get_column ('y')->all ], + [ sort $y_rs->all ], [ 0, sort keys %$cds_per_year ], 'Zero-year groups successfully', ); - # convoluted search taken verbatim from list + # convoluted search taken verbatim from list my $restrict_rs = $rs->search({ -and => [ year => { '!=', 0 }, year => { '!=', undef } ]}); - is_deeply ( - [ $restrict_rs->get_column('y')->all ], - [ $rs->get_column ('y')->all ], + warnings_exist { is_deeply ( + [ sort $restrict_rs->get_column('y')->all ], + [ sort $y_rs->all ], 'Zero year was correctly excluded from resultset', - ); + ) } qr/ + \QUse of distinct => 1 while selecting anything other than a column \E + \Qdeclared on the primary ResultSource is deprecated\E + /x, 'deprecation warning'; } # make sure find hooks determine driver @@ -357,8 +374,77 @@ ZEROINSEARCH: { my $schema = DBICTest::Schema->connect($dsn, $user, $pass); ok (! $schema->storage->_get_dbh->{mysql_auto_reconnect}, 'mysql_auto_reconnect unset regardless of ENV' ); - my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass, { mysql_auto_reconnect => 1 }); - ok ($schema2->storage->_get_dbh->{mysql_auto_reconnect}, 'but is properly set if explicitly requested mysql_auto_reconnect' ); + # Make sure hardcore forking action still works even if mysql_auto_reconnect + # is true (test inspired by ether) + + my $schema_autorecon = DBICTest::Schema->connect($dsn, $user, $pass, { mysql_auto_reconnect => 1 }); + my $orig_dbh = $schema_autorecon->storage->_get_dbh; + weaken $orig_dbh; + + ok ($orig_dbh, 'Got weak $dbh ref'); + ok ($orig_dbh->{mysql_auto_reconnect}, 'mysql_auto_reconnect is properly set if explicitly requested' ); + + my $rs = $schema_autorecon->resultset('Artist'); + + my ($parent_in, $child_out); + pipe( $parent_in, $child_out ) or die "Pipe open failed: $!"; + my $pid = fork(); + if (! defined $pid ) { + die "fork() failed: $!" + } + elsif ($pid) { + close $child_out; + + # sanity check + $schema_autorecon->storage->dbh_do(sub { + is ($_[1], $orig_dbh, 'Storage holds correct $dbh in parent'); + }); + + # kill our $dbh + $schema_autorecon->storage->_dbh(undef); + + { + local $TODO = "Perl $] is known to leak like a sieve" + if DBIx::Class::_ENV_::PEEPEENESS; + + ok (! defined $orig_dbh, 'Parent $dbh handle is gone'); + } + } + else { + close $parent_in; + + #simulate a subtest to not confuse the parent TAP emission + my $tb = Test::More->builder; + $tb->reset; + for (qw/output failure_output todo_output/) { + close $tb->$_; + open ($tb->$_, '>&', $child_out); + } + + # wait for parent to kill its $dbh + sleep 1; + + # try to do something dbic-esque + $rs->create({ name => "Hardcore Forker $$" }); + + { + local $TODO = "Perl $] is known to leak like a sieve" + if DBIx::Class::_ENV_::PEEPEENESS; + + ok (! defined $orig_dbh, 'DBIC operation triggered reconnect - old $dbh is gone'); + } + + done_testing; + exit 0; + } + + while (my $ln = <$parent_in>) { + print " $ln"; + } + wait; + ok(!$?, 'Child subtests passed'); + + ok ($rs->find({ name => "Hardcore Forker $pid" }), 'Expected row created'); } done_testing;