t/storage/base.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Warn;
   6 use lib qw(t/lib);
   7 use DBICTest;
   8 use Data::Dumper;
   9
  10 {
  11     package DBICTest::ExplodingStorage::Sth;
  12     use strict;
  13     use warnings;
  14
  15     sub execute { die "Kablammo!" }
  16
  17     sub bind_param {}
  18
  19     package DBICTest::ExplodingStorage;
  20     use strict;
  21     use warnings;
  22     use base 'DBIx::Class::Storage::DBI::SQLite';
  23
  24     my $count = 0;
  25     sub sth {
  26       my ($self, $sql) = @_;
  27       return bless {},  "DBICTest::ExplodingStorage::Sth" unless $count++;
  28       return $self->next::method($sql);
  29     }
  30
  31     sub connected {
  32       return 0 if $count == 1;
  33       return shift->next::method(@_);
  34     }
  35 }
  36
  37 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
  38
  39 is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite',
  40     'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' );
  41
  42 my $storage = $schema->storage;
  43 $storage->ensure_connected;
  44
  45 eval {
  46     $schema->storage->throw_exception('test_exception_42');
  47 };
  48 like($@, qr/\btest_exception_42\b/, 'basic exception');
  49
  50 eval {
  51     $schema->resultset('CD')->search_literal('broken +%$#$1')->all;
  52 };
  53 like($@, qr/prepare_cached failed/, 'exception via DBI->HandleError, etc');
  54
  55 bless $storage, "DBICTest::ExplodingStorage";
  56 $schema->storage($storage);
  57
  58 eval {
  59     $schema->resultset('Artist')->create({ name => "Exploding Sheep" });
  60 };
  61
  62 is($@, "", "Exploding \$sth->execute was caught");
  63
  64 is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count,
  65   "And the STH was retired");
  66
  67
  68 # testing various invocations of connect_info ([ ... ])
  69
  70 my $coderef = sub { 42 };
  71 my $invocations = {
  72   'connect_info ([ $d, $u, $p, \%attr, \%extra_attr])' => {
  73       args => [
  74           'foo',
  75           'bar',
  76           undef,
  77           {
  78             on_connect_do => [qw/a b c/],
  79             PrintError => 0,
  80           },
  81           {
  82             AutoCommit => 1,
  83             on_disconnect_do => [qw/d e f/],
  84           },
  85           {
  86             unsafe => 1,
  87             auto_savepoint => 1,
  88           },
  89         ],
  90       dbi_connect_info => [
  91           'foo',
  92           'bar',
  93           undef,
  94           {
  95             %{$storage->_default_dbi_connect_attributes || {} },
  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 => 1,
 126             AutoCommit => 0,
 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             %{$storage->_default_dbi_connect_attributes || {} },
 142             PrintError => 1,
 143             AutoCommit => 0,
 144           },
 145       ],
 146   },
 147   'connect_info ([ \%attr_with_coderef ])' => {
 148       args => [ {
 149         dbh_maker => $coderef,
 150         dsn => 'blah',
 151         user => 'bleh',
 152         on_connect_do => [qw/a b c/],
 153         on_disconnect_do => [qw/d e f/],
 154       } ],
 155       dbi_connect_info => [
 156         $coderef
 157       ],
 158       warn => qr/Attribute\(s\) 'dsn', 'user' in connect_info were ignored/,
 159   },
 160 };
 161
 162 for my $type (keys %$invocations) {
 163
 164   # we can not use a cloner portably because of the coderef
 165   # so compare dumps instead
 166   local $Data::Dumper::Sortkeys = 1;
 167   my $arg_dump = Dumper ($invocations->{$type}{args});
 168
 169   warnings_exist (
 170     sub { $storage->connect_info ($invocations->{$type}{args}) },
 171      $invocations->{$type}{warn} || (),
 172     'Warned about ignored attributes',
 173   );
 174
 175   is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments");
 176
 177   is_deeply ($storage->_dbi_connect_info, $invocations->{$type}{dbi_connect_info}, "$type produced correct _dbi_connect_info");
 178   ok ( (not $storage->auto_savepoint and not $storage->unsafe), "$type correctly ignored extra hashref");
 179
 180   is_deeply (
 181     [$storage->on_connect_do, $storage->on_disconnect_do ],
 182     [ [qw/a b c/], [qw/d e f/] ],
 183     "$type correctly parsed DBIC specific on_[dis]connect_do",
 184   );
 185 }
 186
 187 done_testing;
 188
 189 1;