Final count tests
[dbsrgits/DBIx-Class-Historic.git] / t / 92storage.t
1 use strict;
2 use warnings;  
3
4 use Test::More;
5 use lib qw(t/lib);
6 use DBICTest;
7 use Data::Dumper;
8
9 {
10     package DBICTest::ExplodingStorage::Sth;
11     use strict;
12     use warnings;
13
14     sub execute { die "Kablammo!" }
15
16     sub bind_param {}
17
18     package DBICTest::ExplodingStorage;
19     use strict;
20     use warnings;
21     use base 'DBIx::Class::Storage::DBI::SQLite';
22
23     my $count = 0;
24     sub sth {
25       my ($self, $sql) = @_;
26       return bless {},  "DBICTest::ExplodingStorage::Sth" unless $count++;
27       return $self->next::method($sql);
28     }
29
30     sub connected {
31       return 0 if $count == 1;
32       return shift->next::method(@_);
33     }
34 }
35
36 plan tests => 17;
37
38 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
39
40 is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite',
41     'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' );
42
43 my $storage = $schema->storage;
44 $storage->ensure_connected;
45
46 eval {
47     $schema->storage->throw_exception('test_exception_42');
48 };
49 like($@, qr/\btest_exception_42\b/, 'basic exception');
50
51 eval {
52     $schema->resultset('CD')->search_literal('broken +%$#$1')->all;
53 };
54 like($@, qr/prepare_cached failed/, 'exception via DBI->HandleError, etc');
55
56 bless $storage, "DBICTest::ExplodingStorage";
57 $schema->storage($storage);
58
59 eval { 
60     $schema->resultset('Artist')->create({ name => "Exploding Sheep" });
61 };
62
63 is($@, "", "Exploding \$sth->execute was caught");
64
65 is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count,
66   "And the STH was retired");
67
68
69 # testing various invocations of connect_info ([ ... ])
70
71 my $coderef = sub { 42 };
72 my $invocations = {
73   'connect_info ([ $d, $u, $p, \%attr, \%extra_attr])' => {
74       args => [
75           'foo',
76           'bar',
77           undef,
78           {
79             on_connect_do => [qw/a b c/],
80             PrintError => 0,
81           },
82           {
83             AutoCommit => 1,
84             on_disconnect_do => [qw/d e f/],
85           },
86           {
87             unsafe => 1,
88             auto_savepoint => 1,
89           },
90         ],
91       dbi_connect_info => [
92           'foo',
93           'bar',
94           undef,
95           {
96             PrintError => 0,
97             AutoCommit => 1,
98           },
99       ],
100   },
101
102   'connect_info ([ \%code, \%extra_attr ])' => {
103       args => [
104           $coderef,
105           {
106             on_connect_do => [qw/a b c/],
107             PrintError => 0,
108             AutoCommit => 1,
109             on_disconnect_do => [qw/d e f/],
110           },
111           {
112             unsafe => 1,
113             auto_savepoint => 1,
114           },
115         ],
116       dbi_connect_info => [
117           $coderef,
118       ],
119   },
120
121   'connect_info ([ \%attr ])' => {
122       args => [
123           {
124             on_connect_do => [qw/a b c/],
125             PrintError => 0,
126             AutoCommit => 1,
127             on_disconnect_do => [qw/d e f/],
128             user => 'bar',
129             dsn => 'foo',
130           },
131           {
132             unsafe => 1,
133             auto_savepoint => 1,
134           },
135       ],
136       dbi_connect_info => [
137           'foo',
138           'bar',
139           undef,
140           {
141             PrintError => 0,
142             AutoCommit => 1,
143           },
144       ],
145   },
146 };
147
148 for my $type (keys %$invocations) {
149
150   # we can not use a cloner portably because of the coderef
151   # so compare dumps instead
152   local $Data::Dumper::Sortkeys = 1;
153   my $arg_dump = Dumper ($invocations->{$type}{args});
154
155   $storage->connect_info ($invocations->{$type}{args});
156
157   is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments");
158
159
160   is_deeply ($storage->_dbi_connect_info, $invocations->{$type}{dbi_connect_info}, "$type produced correct _dbi_connect_info");
161   ok ( (not $storage->auto_savepoint and not $storage->unsafe), "$type correctly ignored extra hashref");
162
163   is_deeply (
164     [$storage->on_connect_do, $storage->on_disconnect_do ],
165     [ [qw/a b c/], [qw/d e f/] ],
166     "$type correctly parsed DBIC specific on_[dis]connect_do",
167   );
168 }
169
170 1;