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 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
  12
  13 is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite',
  14     'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' );
  15
  16 my $storage = $schema->storage;
  17 $storage->ensure_connected;
  18
  19 throws_ok {
  20     $schema->storage->throw_exception('test_exception_42');
  21 } qr/\btest_exception_42\b/, 'basic exception';
  22
  23 throws_ok {
  24     $schema->resultset('CD')->search_literal('broken +%$#$1')->all;
  25 } qr/prepare_cached failed/, 'exception via DBI->HandleError, etc';
  26
  27
  28 # testing various invocations of connect_info ([ ... ])
  29
  30 my $coderef = sub { 42 };
  31 my $invocations = {
  32   'connect_info ([ $d, $u, $p, \%attr, \%extra_attr])' => {
  33       args => [
  34           'foo',
  35           'bar',
  36           undef,
  37           {
  38             on_connect_do => [qw/a b c/],
  39             PrintError => 0,
  40           },
  41           {
  42             AutoCommit => 1,
  43             on_disconnect_do => [qw/d e f/],
  44           },
  45           {
  46             unsafe => 1,
  47             auto_savepoint => 1,
  48           },
  49         ],
  50       dbi_connect_info => [
  51           'foo',
  52           'bar',
  53           undef,
  54           {
  55             %{$storage->_default_dbi_connect_attributes || {} },
  56             PrintError => 0,
  57             AutoCommit => 1,
  58           },
  59       ],
  60   },
  61
  62   'connect_info ([ \%code, \%extra_attr ])' => {
  63       args => [
  64           $coderef,
  65           {
  66             on_connect_do => [qw/a b c/],
  67             PrintError => 0,
  68             AutoCommit => 1,
  69             on_disconnect_do => [qw/d e f/],
  70           },
  71           {
  72             unsafe => 1,
  73             auto_savepoint => 1,
  74           },
  75         ],
  76       dbi_connect_info => [
  77           $coderef,
  78       ],
  79   },
  80
  81   'connect_info ([ \%attr ])' => {
  82       args => [
  83           {
  84             on_connect_do => [qw/a b c/],
  85             PrintError => 1,
  86             AutoCommit => 0,
  87             on_disconnect_do => [qw/d e f/],
  88             user => 'bar',
  89             dsn => 'foo',
  90           },
  91           {
  92             unsafe => 1,
  93             auto_savepoint => 1,
  94           },
  95       ],
  96       dbi_connect_info => [
  97           'foo',
  98           'bar',
  99           undef,
 100           {
 101             %{$storage->_default_dbi_connect_attributes || {} },
 102             PrintError => 1,
 103             AutoCommit => 0,
 104           },
 105       ],
 106       warn => qr/\QYou provided explicit AutoCommit => 0 in your connection_info/,
 107   },
 108   'connect_info ([ \%attr_with_coderef ])' => {
 109       args => [ {
 110         dbh_maker => $coderef,
 111         dsn => 'blah',
 112         user => 'bleh',
 113         on_connect_do => [qw/a b c/],
 114         on_disconnect_do => [qw/d e f/],
 115       } ],
 116       dbi_connect_info => [
 117         $coderef
 118       ],
 119       warn => qr/Attribute\(s\) 'dsn', 'user' in connect_info were ignored/,
 120   },
 121 };
 122
 123 for my $type (keys %$invocations) {
 124
 125   # we can not use a cloner portably because of the coderef
 126   # so compare dumps instead
 127   local $Data::Dumper::Sortkeys = 1;
 128   my $arg_dump = Dumper ($invocations->{$type}{args});
 129
 130   warnings_exist (
 131     sub { $storage->connect_info ($invocations->{$type}{args}) },
 132      $invocations->{$type}{warn} || (),
 133     'Warned about ignored attributes',
 134   );
 135
 136   is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments");
 137
 138   is_deeply ($storage->_dbi_connect_info, $invocations->{$type}{dbi_connect_info}, "$type produced correct _dbi_connect_info");
 139   ok ( (not $storage->auto_savepoint and not $storage->unsafe), "$type correctly ignored extra hashref");
 140
 141   is_deeply (
 142     [$storage->on_connect_do, $storage->on_disconnect_do ],
 143     [ [qw/a b c/], [qw/d e f/] ],
 144     "$type correctly parsed DBIC specific on_[dis]connect_do",
 145   );
 146 }
 147
 148 done_testing;
 149
 150 1;