use Sub::Name 'subname';
use Try::Tiny;
use File::Path 'make_path';
+use overload ();
use namespace::clean;
# will get the same rdbms version). _determine_supports_X does not need to
# exist on a driver, as we ->can for it before calling.
-my @capabilities = (qw/insert_returning placeholders typeless_placeholders join_optimizer/);
+my @capabilities = (qw/
+ insert_returning
+ insert_returning_bound
+ placeholders
+ typeless_placeholders
+ join_optimizer
+/);
__PACKAGE__->mk_group_accessors( dbms_capability => map { "_supports_$_" } @capabilities );
__PACKAGE__->mk_group_accessors( use_dbms_capability => map { "_use_$_" } (@capabilities ) );
local $self->{_in_dbh_do} = 1;
my @result;
- my $want_array = wantarray;
+ my $want = wantarray;
my $tried = 0;
while(1) {
try {
$self->txn_begin;
my $txn_start_depth = $self->transaction_depth;
- if($want_array) {
+ if($want) {
@result = $coderef->(@$args);
}
- elsif(defined $want_array) {
+ elsif(defined $want) {
$result[0] = $coderef->(@$args);
}
else {
$exception = $_;
};
- if(! defined $exception) { return $want_array ? @result : $result[0] }
+ if(! defined $exception) { return wantarray ? @result : $result[0] }
if($self->transaction_depth > 1 || $tried++ || $self->connected) {
my $rollback_exception;
sub txn_commit {
my $self = shift;
- if ($self->{transaction_depth} == 1) {
+ if (! $self->_dbh) {
+ $self->throw_exception('cannot COMMIT on a disconnected handle');
+ }
+ elsif ($self->{transaction_depth} == 1) {
$self->debugobj->txn_commit()
if ($self->debug);
$self->_dbh_commit;
$self->svp_release
if $self->auto_savepoint;
}
+ elsif (! $self->_dbh->FETCH('AutoCommit') ) {
+
+ carp "Storage transaction_depth $self->{transaction_depth} does not match "
+ ."false AutoCommit of $self->{_dbh}, attempting COMMIT anyway";
+
+ $self->debugobj->txn_commit()
+ if ($self->debug);
+ $self->_dbh_commit;
+ $self->{transaction_depth} = 0
+ if $self->_dbh_autocommit;
+ }
else {
$self->throw_exception( 'Refusing to commit without a started transaction' );
}
foreach my $data (@data) {
my $ref = ref $data;
- $data = $ref && $ref ne 'ARRAY' ? ''.$data : $data; # stringify args (except arrayrefs)
- $sth->bind_param($placeholder_index, $data, $attributes);
- $placeholder_index++;
+ if ($ref and overload::Method($data, '""') ) {
+ $data = "$data";
+ }
+ elsif ($ref eq 'SCALAR') { # any scalarrefs are assumed to be bind_inouts
+ $sth->bind_param_inout(
+ $placeholder_index++,
+ $data,
+ $self->_max_column_bytesize($ident, $column_name),
+ $attributes
+ );
+ next;
+ }
+
+ $sth->bind_param($placeholder_index++, $data, $attributes);
}
}
)
) {
$values{$col} = $self->_sequence_fetch(
- 'nextval',
+ 'NEXTVAL',
( $colinfo->{$col}{sequence} ||=
$self->_dbh_get_autoinc_seq($self->_get_dbh, $source, $col)
),
# list of primary keys we try to fetch from the database
# both not-exsists and scalarrefs are considered
my %fetch_pks;
- %fetch_pks = ( map
- { $_ => scalar keys %fetch_pks } # so we can preserve order for prettyness
- grep
- { ! exists $to_insert->{$_} or ref $to_insert->{$_} eq 'SCALAR' }
- $source->primary_columns
- );
+ for ($source->primary_columns) {
+ $fetch_pks{$_} = scalar keys %fetch_pks # so we can preserve order for prettyness
+ if ! exists $to_insert->{$_} or ref $to_insert->{$_} eq 'SCALAR';
+ }
- my $sqla_opts;
+ my ($sqla_opts, @ir_container);
if ($self->_use_insert_returning) {
# retain order as declared in the resultsource
for (sort { $fetch_pks{$a} <=> $fetch_pks{$b} } keys %fetch_pks ) {
push @{$sqla_opts->{returning}}, $_;
+ $sqla_opts->{returning_container} = \@ir_container
+ if $self->_use_insert_returning_bound;
}
}
my %returned_cols;
if (my $retlist = $sqla_opts->{returning}) {
- my @ret_vals = try {
+ @ir_container = try {
local $SIG{__WARN__} = sub {};
my @r = $sth->fetchrow_array;
$sth->finish;
@r;
- };
+ } unless @ir_container;
- @returned_cols{@$retlist} = @ret_vals if @ret_vals;
+ @returned_cols{@$retlist} = @ir_container if @ir_container;
}
return { %$prefetched_values, %returned_cols };
from => $ident,
where => $where,
$rs_alias && $alias2source->{$rs_alias}
- ? ( _rsroot_source_handle => $alias2source->{$rs_alias}->handle )
+ ? ( _rsroot_rsrc => $alias2source->{$rs_alias} )
: ()
,
};
&&
@{$attrs->{group_by}}
&&
- $attrs->{_prefetch_select}
- &&
- @{$attrs->{_prefetch_select}}
+ $attrs->{_prefetch_selector_range}
)
) {
($ident, $select, $where, $attrs)
);
my @ret;
- my $wa = wantarray;
- if ($wa) {
+ if (wantarray) {
@ret = $tr->translate;
}
else {
$self->throw_exception( 'Unable to produce deployment statements: ' . $tr->error)
unless (@ret && defined $ret[0]);
- return $wa ? @ret : $ret[0];
+ return wantarray ? @ret : $ret[0];
}
sub deploy {
return $alias;
}
+# The size in bytes to use for DBI's ->bind_param_inout, this is the generic
+# version and it may be necessary to amend or override it for a specific storage
+# if such binds are necessary.
+sub _max_column_bytesize {
+ my ($self, $source, $col) = @_;
+
+ my $inf = $source->column_info($col);
+ return $inf->{_max_bytesize} ||= do {
+
+ my $max_size;
+
+ if (my $data_type = $inf->{data_type}) {
+ $data_type = lc($data_type);
+
+ # String/sized-binary types
+ if ($data_type =~ /^(?:l?(?:var)?char(?:acter)?(?:\s*varying)?
+ |(?:var)?binary(?:\s*varying)?|raw)\b/x
+ ) {
+ $max_size = $inf->{size};
+ }
+ # Other charset/unicode types, assume scale of 4
+ elsif ($data_type =~ /^(?:national\s*character(?:\s*varying)?|nchar
+ |univarchar
+ |nvarchar)\b/x
+ ) {
+ $max_size = $inf->{size} * 4 if $inf->{size};
+ }
+ # Blob types
+ elsif ($self->_is_lob_type($data_type)) {
+ # default to longreadlen
+ }
+ else {
+ $max_size = 100; # for all other (numeric?) datatypes
+ }
+ }
+
+ $max_size ||= $self->_get_dbh->{LongReadLen} || 8000;
+ };
+}
+
+# Determine if a data_type is some type of BLOB
+sub _is_lob_type {
+ my ($self, $data_type) = @_;
+ $data_type && ($data_type =~ /(?:lob|bfile|text|image|bytea|memo)/i
+ || $data_type =~ /^long(?:\s*(?:raw|bit\s*varying|varbit|binary
+ |varchar|character\s*varying|nvarchar
+ |national\s*character\s*varying))?$/xi);
+}
+
1;
=head1 USAGE NOTES
projects / dbsrgits/DBIx-Class.git / blobdiff