t/storage/exception.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8 use lib qw(t/lib);
   9 use DBICTest;
  10 use DBICTest::Schema;
  11
  12 {
  13   package Dying::Storage;
  14
  15   use warnings;
  16   use strict;
  17
  18   use base 'DBIx::Class::Storage::DBI';
  19
  20   sub _populate_dbh {
  21     my $self = shift;
  22     my $death = $self->_dbi_connect_info->[3]{die};
  23
  24     die "storage test died: $death" if $death eq 'before_populate';
  25     my $ret = $self->next::method (@_);
  26     die "storage test died: $death" if $death eq 'after_populate';
  27
  28     return $ret;
  29   }
  30 }
  31
  32 TODO: {
  33 local $TODO = "I have no idea what is going on here... but it ain't right";
  34
  35 for (qw/before_populate after_populate/) {
  36
  37   dies_ok (sub {
  38     my $schema = DBICTest::Schema->clone;
  39     $schema->storage_type ('Dying::Storage');
  40     $schema->connection (DBICTest->_database, { die => $_ });
  41     $schema->storage->ensure_connected;
  42   }, "$_ exception found");
  43 }
  44
  45 }
  46
  47 done_testing;
  48
  49 __END__
  50 For reference - next::method goes to ::Storage::DBI::_populate_dbh
  51 which is:
  52
  53 sub _populate_dbh {
  54   my ($self) = @_;
  55
  56   my @info = @{$self->_dbi_connect_info || []};
  57   $self->_dbh(undef); # in case ->connected failed we might get sent here
  58   $self->_dbh($self->_connect(@info));
  59
  60   $self->_conn_pid($$);
  61   $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
  62
  63   $self->_determine_driver;
  64
  65   # Always set the transaction depth on connect, since
  66   #  there is no transaction in progress by definition
  67   $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
  68
  69   $self->_run_connection_actions unless $self->{_in_determine_driver};
  70 }
  71
  72 After further tracing it seems that if I die() before $self->_conn_pid($$)
  73 the exception is propagated. If I die after it - it's lost. What The Fuck?!