# We were not connected - reconnect and retry, but let any
# exception fall right through this time
+ carp "Retrying $code after catching disconnected exception: $exception"
+ if $ENV{DBIC_DBIRETRY_DEBUG};
$self->_populate_dbh;
$self->$code($self->_dbh, @_);
}
# We were not connected, and was first try - reconnect and retry
# via the while loop
+ carp "Retrying $coderef after catching disconnected exception: $exception"
+ if $ENV{DBIC_DBIRETRY_DEBUG};
$self->_populate_dbh;
}
}
# alias any functions to the dbic-side 'as' label
# adjust the outer select accordingly
- if (ref $sel eq 'HASH' && !$sel->{-select}) {
- $sel = { -select => $sel, -as => $attrs->{as}[$i] };
- $select->[$i] = join ('.', $attrs->{alias}, ($attrs->{as}[$i] || "select_$i") );
+ if (ref $sel eq 'HASH' ) {
+ $sel->{-as} ||= $attrs->{as}[$i];
+ $select->[$i] = join ('.', $attrs->{alias}, ($sel->{-as} || "select_$i") );
}
push @$sub_select, $sel;
sub sqlt_type { shift->_get_dbh->{Driver}->{Name} }
+# By default there is no resolution of DBIC data types to DBI data types
+# In essence this makes e.g. AutoCast a noop
+sub _dbi_data_type {
+ #my ($self, $data_type) = @_;
+ return undef
+};
+
=head2 bind_attribute_by_data_type
Given a datatype from column info, returns a database specific bind
. $self->_check_sqlt_message . q{'})
if !$self->_check_sqlt_version;
- require SQL::Translator::Parser::DBIx::Class;
- eval qq{use SQL::Translator::Producer::${type}};
- $self->throw_exception($@) if $@;
-
# sources needs to be a parser arg, but for simplicty allow at top level
# coming in
$sqltargs->{parser_args}{sources} = delete $sqltargs->{sources}
if exists $sqltargs->{sources};
- my $tr = SQL::Translator->new(%$sqltargs);
- SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
- return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
+ my $tr = SQL::Translator->new(
+ producer => "SQL::Translator::Producer::${type}",
+ %$sqltargs,
+ parser => 'SQL::Translator::Parser::DBIx::Class',
+ data => $schema,
+ );
+ return $tr->translate;
}
sub deploy {
sub DESTROY {
my $self = shift;
- return if !$self->_dbh;
- $self->_verify_pid;
+ $self->_verify_pid if $self->_dbh;
+
+ # some databases need this to stop spewing warnings
+ if (my $dbh = $self->_dbh) {
+ eval { $dbh->disconnect };
+ }
+
$self->_dbh(undef);
}