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;