use strict;
-use warnings;
+use warnings;
use Test::More;
use Test::Exception;
+
+use DBI::Const::GetInfoType;
+use Scalar::Util qw/weaken/;
+
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/};
$it->next;
is( $it->next, undef, "next past end of resultset ok" );
+# Limit with select-lock
+lives_ok {
+ $schema->txn_do (sub {
+ isa_ok (
+ $schema->resultset('Artist')->find({artistid => 1}, {for => 'update', rows => 1}),
+ 'DBICTest::Schema::Artist',
+ );
+ });
+} 'Limited FOR UPDATE select works';
+
+# shared-lock
+lives_ok {
+ $schema->txn_do (sub {
+ isa_ok (
+ $schema->resultset('Artist')->find({artistid => 1}, {for => 'shared'}),
+ 'DBICTest::Schema::Artist',
+ );
+ });
+} 'LOCK IN SHARE MODE select works';
+
my $test_type_info = {
'artistid' => {
'data_type' => 'INT',
);
}
+{
+ # 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?
##
## Only way is to do a SET SQL_AUTO_IS_NULL = 0; on connect
=> 'Nothing Found!';
}
+# check for proper grouped counts
+{
+ my $ansi_schema = DBICTest::Schema->connect ($dsn, $user, $pass, {
+ on_connect_call => 'set_strict_mode',
+ quote_char => '`',
+ });
+ my $rs = $ansi_schema->resultset('CD');
+
+ my $years;
+ $years->{$_->year|| scalar keys %$years}++ for $rs->all; # NULL != NULL, thus the keys eval
+
+ lives_ok ( sub {
+ is (
+ $rs->search ({}, { group_by => 'year'})->count,
+ scalar keys %$years,
+ 'grouped count correct',
+ );
+ }, 'Grouped count does not throw');
+
+ lives_ok( sub {
+ $ansi_schema->resultset('Owners')->search({}, {
+ join => 'books', group_by => [ 'me.id', 'books.id' ]
+ })->count();
+ }, 'count on grouped columns with the same name does not throw');
+
+
+}
+
ZEROINSEARCH: {
my $cds_per_year = {
2001 => 2,
);
}
-## If find() is the first query after connect()
-## DBI::Storage::sql_maker() will be called before
-## _determine_driver() and so the ::SQLHacks class for MySQL
-## will not be used
+# make sure find hooks determine driver
+{
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+ $schema->resultset("Artist")->find(4);
+ isa_ok($schema->storage->sql_maker, 'DBIx::Class::SQLMaker::MySQL');
+}
+
+# make sure the mysql_auto_reconnect buggery is avoided
+{
+ local $ENV{MOD_PERL} = 'boogiewoogie';
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+ ok (! $schema->storage->_get_dbh->{mysql_auto_reconnect}, 'mysql_auto_reconnect unset regardless of ENV' );
+
+ # 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 $pid = fork();
+ if (! defined $pid ) {
+ die "fork() failed: $!"
+ }
+ elsif ($pid) {
+ # 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);
+
+ TODO: {
+ local $TODO = "Perl $] is known to leak like a sieve"
+ if DBIx::Class::_ENV_::PEEPEENESS();
-my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
-$schema2->resultset("Artist")->find(4);
-isa_ok($schema2->storage->sql_maker, 'DBIx::Class::SQLAHacks::MySQL');
+ ok (! defined $orig_dbh, 'Parent $dbh handle is gone');
+ }
+ }
+ else {
+ # wait for parent to kill its $dbh
+ sleep 1;
+
+ #simulate a subtest to not confuse the parent TAP emission
+ Test::More->builder->reset;
+ Test::More->builder->plan('no_plan');
+ Test::More->builder->_indent(' ' x 4);
+
+ # try to do something dbic-esque
+ $rs->create({ name => "Hardcore Forker $$" });
+
+
+ TODO: {
+ 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');
+ }
+
+ exit 0;
+ }
+
+ wait;
+ ok(!$?, 'Child subtests passed');
+
+ ok ($rs->find({ name => "Hardcore Forker $pid" }), 'Expected row created');
+}
done_testing;