DBIx-OnlineDDL

 view release on metacpan or  search on metacpan

lib/DBIx/OnlineDDL.pm  view on Meta::CPAN

712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
my $dbi_attrs = $conn->connect_info->[3];
 
# Playing with refs, so no need to re-set connect_info
$conn->connect_info->[3] = $dbi_attrs = {} unless $dbi_attrs;
 
# Make sure the basic settings are sane
$dbi_attrs->{AutoCommit} = 1;
$dbi_attrs->{RaiseError} = 1;
 
# Add the DBI callback
my $callbacks  = $dbi_attrs->{Callbacks} //= {};
my $package_re = quotemeta(__PACKAGE__.'::_dbi_connected_callback');
 
my $ref = defined $callbacks->{connected} && ref $callbacks->{connected};
unless ($callbacks->{connected}) {
    $callbacks->{connected} = set_subname '_dbi_connected_callback' => sub {
        shift->do($_) for @stmts;
        return;
    };
}
elsif (!$ref || $ref ne 'CODE') {
    die "Illegal reftype $ref for connected DBI Callback!";
}
elsif (subname($callbacks->{connected}) =~ /^$package_re/) {  # allow for *_wrapped below
    # This is one of our callbacks; leave it alone!
}
else {
    # This is somebody else's callback; wrap around it
    my $old_coderef = $callbacks->{connected};
    $callbacks->{connected} = set_subname '_dbi_connected_callback_wrapped' => sub {
        my $h = shift;
        $old_coderef->($h);
        $h->do($_) for @stmts;
        return;
    };
}
 
# Add a proper retry_handler
$conn->retry_handler(sub { $self->_retry_handler(@_) });



( run in 0.371 second using v1.01-cache-2.11-cpan-00829025b61 )