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