use DBIx::Class::Carp;
use Scalar::Util qw/refaddr weaken reftype blessed/;
use Context::Preserve 'preserve_context';
-use Try::Tiny;
use SQL::Abstract qw(is_plain_value is_literal_value);
use DBIx::Class::_Util qw(
quote_sub perlstring serialize dump_value
- dbic_internal_try
+ dbic_internal_try dbic_internal_catch
detected_reinvoked_destructor scope_guard
mkdir_p
);
my $server_version = dbic_internal_try {
$self->_get_server_version
- } catch {
+ } dbic_internal_catch {
# driver determination *may* use this codepath
# in which case we must rethrow
$self->throw_exception($_) if $self->{_in_determine_driver};
if ((not $self->_driver_determined) && (not $self->{_in_determine_driver})) {
my $started_connected = 0;
- local $self->{_in_determine_driver} = 1;
+
+ local $self->{_in_determine_driver} = 1
+ unless $self->{_in_determine_driver};
if (ref($self) eq __PACKAGE__) {
my $driver;
if ($driver) {
my $storage_class = "DBIx::Class::Storage::DBI::${driver}";
if ($self->load_optional_class($storage_class)) {
- mro::set_mro($storage_class, 'c3');
+
+ no strict 'refs';
+ mro::set_mro($storage_class, 'c3') if
+ (
+ ${"${storage_class}::__INITIAL_MRO_UPON_DBIC_LOAD__"}
+ ||= mro::get_mro($storage_class)
+ )
+ ne
+ 'c3'
+ ;
+
bless $self, $storage_class;
$self->_rebless();
}
$self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
}
}
- catch {
+ dbic_internal_catch {
if ( $method_prefix =~ /^connect/ ) {
# this is an on_connect cycle - we can't just throw while leaving
# a handle in an undefined state in our storage object
$dbh_error_handler_installer->($self, $dbh);
}
}
- catch {
+ dbic_internal_catch {
$self->throw_exception("DBI Connection failed: $_")
};
$op eq 'select'
and
grep {
- length ref $_->[1]
- and
- blessed($_->[1])
+ defined blessed($_->[1])
and
$_->[1]->isa('DateTime')
} @$bind
# they can be fused once again with the final return
$to_insert = { %$to_insert, %$prefetched_values };
- # FIXME - we seem to assume undef values as non-supplied. This is wrong.
- # Investigate what does it take to s/defined/exists/
my %pcols = map { $_ => 1 } $source->primary_columns;
+
my (%retrieve_cols, $autoinc_supplied, $retrieve_autoinc_col);
+
for my $col ($source->columns) {
+
+ # first autoinc wins - this is why ->columns() in-order iteration is important
+ #
+ # FIXME - there ought to be a sanity-check for multiple is_auto_increment settings
+ # or something...
+ #
if ($col_infos->{$col}{is_auto_increment}) {
+
+ # FIXME - we seem to assume undef values as non-supplied.
+ # This is wrong.
+ # Investigate what does it take to s/defined/exists/
+ # ( fails t/cdbi/copy.t amoong other things )
$autoinc_supplied ||= 1 if defined $to_insert->{$col};
+
$retrieve_autoinc_col ||= $col unless $autoinc_supplied;
}
# nothing to retrieve when explicit values are supplied
next if (
- defined $to_insert->{$col} and ! is_literal_value($to_insert->{$col})
+ # FIXME - we seem to assume undef values as non-supplied.
+ # This is wrong.
+ # Investigate what does it take to s/defined/exists/
+ # ( fails t/cdbi/copy.t amoong other things )
+ defined $to_insert->{$col}
+ and
+ (
+ # not a ref - cheaper to check before a call to is_literal_value()
+ ! length ref $to_insert->{$col}
+ or
+ # not a literal we *MAY* need to pull out ( see check below )
+ ! is_literal_value( $to_insert->{$col} )
+ )
);
# the 'scalar keys' is a trick to preserve the ->columns declaration order
);
};
+ # corner case of a non-supplied PK which is *not* declared as autoinc
+ if (
+ ! $autoinc_supplied
+ and
+ ! defined $retrieve_autoinc_col
+ and
+ # FIXME - first come-first serve, suboptimal...
+ ($retrieve_autoinc_col) = ( grep
+ {
+ $pcols{$_}
+ and
+ ! $col_infos->{$_}{retrieve_on_insert}
+ and
+ ! defined $col_infos->{$_}{is_auto_increment}
+ }
+ sort
+ { $retrieve_cols{$a} <=> $retrieve_cols{$b} }
+ keys %retrieve_cols
+ )
+ ) {
+ carp_unique(
+ "Missing value for primary key column '$retrieve_autoinc_col' on "
+ . "@{[ $source->source_name ]} - perhaps you forgot to set its "
+ . "'is_auto_increment' attribute during add_columns()? Treating "
+ . "'$retrieve_autoinc_col' implicitly as an autoinc, and attempting "
+ . 'value retrieval'
+ );
+ }
+
local $self->{_autoinc_supplied_for_op} = $autoinc_supplied;
local $self->{_perform_autoinc_retrieval} = $retrieve_autoinc_col;
@ir_container = $sth->fetchrow_array;
$sth->finish;
- } catch {
+ } dbic_internal_catch {
# Evict the $sth from the cache in case we got here, since the finish()
# is crucial, at least on older Firebirds, possibly on other engines too
#
$tuple_status,
);
}
- catch {
+ dbic_internal_catch {
$err = shift;
};
dbic_internal_try {
$sth->finish
}
- catch {
+ dbic_internal_catch {
$err = shift unless defined $err
};
$sth->execute foreach 1..$count;
}
- catch {
+ dbic_internal_catch {
$err = shift;
};
dbic_internal_try {
$sth->finish
}
- catch {
+ dbic_internal_catch {
$err = shift unless defined $err;
};
$result{$col_name} = \%column_info;
}
- } catch {
+ } dbic_internal_catch {
%result = ();
};
sub deployment_statements {
my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
+
+ $self->throw_exception(
+ 'Calling deployment_statements() in void context makes no sense'
+ ) unless defined wantarray;
+
$type ||= $self->sqlt_type;
$version ||= $schema->schema_version || '1.x';
$dir ||= './';
# do a dbh_do cycle here, as we need some error checking in
# place (even though we will ignore errors)
$self->dbh_do (sub { $_[1]->do($line) });
- } catch {
+ } dbic_internal_catch {
carp qq{$_ (running "${line}")};
};
$self->_query_end($line);
projects / dbsrgits/DBIx-Class.git / blobdiff