t/storage/base.t

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