1package My::DBI; 2 3$|++; 4use strict; 5use base 'Ima::DBI'; 6use Test::More tests => 27; 7 8sub new { return bless {}; } 9 10# Test set_db 11__PACKAGE__->set_db('test1', 'dbi:ExampleP:', '', '', 12 { AutoCommit => 1, Taint => 0 }); 13__PACKAGE__->set_db('test2', 'dbi:ExampleP:', '', '', 14 { AutoCommit => 1, foo => 1 }); 15 16ok(__PACKAGE__->can('db_test1'), 'set_db("test1")'); 17ok(__PACKAGE__->can('db_test2'), 'set_db("test2")'); 18 19ok eq_array([ sort __PACKAGE__->db_names ], [ sort qw/test1 test2/ ]), 20 'db_names'; 21ok eq_array([ sort __PACKAGE__->db_handles ], 22 [ sort (__PACKAGE__->db_test1, __PACKAGE__->db_test2) ]), 23 'db_handles'; 24 25# Test set_sql 26__PACKAGE__->set_sql('test1', 'select foo from bar where yar = ?', 'test1'); 27__PACKAGE__->set_sql('test2', 'select mode,size,name from ?', 'test2'); 28__PACKAGE__->set_sql('test3', 'select %s from ?', 'test1'); 29__PACKAGE__->set_sql('test4', 'select %s from ?', 'test1', 0); 30__PACKAGE__->set_sql('test5', 'select mode,size,name from ?', 'test1'); 31 32for (1 .. 5) { 33 ok __PACKAGE__->can("sql_test$_"), "SQL for test$_ set up"; 34} 35 36ok eq_array( 37 [ sort __PACKAGE__->sql_names ], 38 [ sort qw/test1 test2 test3 test4 test5/ ] 39 ), 40 'sql_names'; 41 42my $obj = My::DBI->new; 43 44# Test sql_* 45 46use Cwd; 47my $dir = cwd(); 48my ($col0, $col1, $col2); 49 50# Test execute & fetch 51{ 52 my $sth = $obj->sql_test2; 53 isa_ok $sth, 'DBIx::ContextualFetch::st'; 54 ok $sth->{Taint}, "Taint mode on queries in db1"; 55 ok $sth->execute([$dir], [ \($col0, $col1, $col2) ]), "Execute"; 56 my @row_a = $sth->fetch; 57 ok eq_array(\@row_a, [ ($col0, $col1, $col2) ]), "Values OK"; 58 $sth->finish; 59} 60 61# Test fetch_hash 62{ 63 my $sth = $obj->sql_test2; 64 $sth->execute($dir); 65 my %row_hash = $sth->fetch_hash; 66 is keys %row_hash, 3, "3 values fetched back in hash"; 67 eval { 1 while (my %row = $sth->fetch_hash); }; 68 ok(!$@, "fetch_hash() doesn't blow up at the end of its fetching"); 69} 70 71# Test fetch_row/fetch_val/fetch_col 72{ 73 my $sth = $obj->sql_test2; 74 75 my @row = $sth->select_row($dir); 76 is @row, 3, "select_row got 3 values"; 77 78 my $val = $sth->select_val($dir); 79 is $val, $row[0], "select_val is first entry in row"; 80 81 my @col = $sth->select_col($dir); 82 is $val, $col[0], "... and first entry in column"; 83} 84 85# Test dynamic SQL generation. 86{ 87 my $sth = $obj->sql_test3(join ',', qw/mode size name/); 88 89 ok !$sth->{Taint}, "Taint mode off for queries in db2"; 90 my $new_sth = $obj->sql_test3(join ',', qw/mode size name/); 91 is $new_sth, $sth, 'Cached handles'; 92 93 # TODO: { 94 # local $TODO = "Clear sth cache"; 95 # $sth->clear_cache; 96 # my $another_sth = $obj->sql_test3(join ', ', qw/mode size name/); 97 # isnt $another_sth, $sth, 'Get a new sth after clearing cache'; 98 # } 99 100 $new_sth = $obj->sql_test3(join ', ', qw/mode name/); 101 isnt $new_sth, $sth, 'redefined statement'; 102 103 $sth = $obj->sql_test4(join ',', qw/mode size name/); 104 isa_ok $sth, 'DBIx::ContextualFetch::st'; 105 106 $new_sth = $obj->sql_test4(join ',', qw/mode size name/); 107 isa_ok $sth, 'DBIx::ContextualFetch::st'; 108 isnt $new_sth, $sth, 'cached handles off'; 109} 110 111{ 112 my $dbh = __PACKAGE__->db_test1; 113 my $sth5 = __PACKAGE__->sql_test5; 114 my $new_dbh = __PACKAGE__->db_test1; 115 is $dbh, $new_dbh, 'dbh handle caching'; 116 117 # TODO: { 118 # local $TODO = "Clear dbh cache"; 119 # $dbh->clear_cache; 120 # my $another_dbh = __PACKAGE__->db_test1; 121 # isnt $another_dbh, $dbh, '$dbh->clear_cache'; 122 # 123 # my $new_sth5 = __PACKAGE__->sql_test5; 124 # isnt $sth5, $new_sth5, ' handles flushed, too'; 125 # } 126} 127 128eval { Ima::DBI->i_dont_exist; }; 129 130# There's some odd precedence problem trying to pass this all at once. 131my $ok = $@ =~ /^Can\'t locate object method "i_dont_exist" via package/; 132ok $ok, 'Accidental AutoLoader inheritance blocked'; 133