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};
$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 = ();
};
# 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);