1use strict; 2use Test::More tests => 10; 3 4BEGIN { 5 # trick DBI.pm into thinking we are running under mod_perl 6 # set both %ENV keys for old and new DBI versions 7 8 $ENV{MOD_PERL} = 'CGI-Perl'; # for $DBI::VERSION > 1.33 9 $ENV{GATEWAY_INTERFACE} = 'CGI-Perl'; # for older DBI.pm 10 11 use_ok('Apache::DBI'); 12 use_ok('DBI'); 13}; 14 15my $dbd_mysql = eval { require DBD::mysql }; 16 17#$Apache::DBI::DEBUG = 10; 18#DBI->trace(2"); 19 20SKIP: { 21 skip "Could not load DBD::mysql", 8 unless $dbd_mysql; 22 23 ok($dbd_mysql, "DBD::mysql loaded"); 24 25 SKIP: { 26 skip 'Can only check "connect_via" in DBI >= 1.38', 1 unless $DBI::VERSION >= 1.38; 27 28 # checking private DBI data here is probably bad... 29 is($DBI::connect_via, 'Apache::DBI::connect', 'DBI is using Apache::DBI'); 30 } 31 32 33 my $dbh_1 = DBI->connect('dbi:mysql:test', undef, undef, { RaiseError => 0, PrintError => 0 }); 34 35 SKIP: { 36 skip "Could not connect to test database: $DBI::errstr", 6 unless $dbh_1; 37 38 isa_ok($dbh_1, 'Apache::DBI::db'); 39 40 ok(my $thread_1 = $dbh_1->{'mysql_thread_id'}, "Connected 1"); 41 42 my $dbh_2 = DBI->connect('dbi:mysql:test', undef, undef, { RaiseError => 0, PrintError => 0 }); 43 ok(my $thread_2 = $dbh_2->{'mysql_thread_id'}, "Connected 2"); 44 45 is($thread_1, $thread_2, "got the same connection both times"); 46 47 my $dbh_3 = DBI->connect('dbi:mysql:test', undef, undef, { RaiseError => 0, PrintError => 1 }); 48 ok(my $thread_3 = $dbh_3->{'mysql_thread_id'}, "Connected 3"); 49 50 isnt($thread_1, $thread_3, "got different connection from different attributes"); 51 52 } 53 54} 55 561; 57