Make a separate path for as_query, so that the sql does not pass thorugh storage
multiple times. Also do not mangle the sql unless blob binds are detected.
# easier to override in NoBindVars without duping the rest. It takes up
# all of _execute's args, and emits $sql, @bind.
sub _prep_for_execute {
+ #my ($self, $op, $ident, $args) = @_;
+ return shift->_gen_sql_bind(@_)
+}
+
+sub _gen_sql_bind {
my ($self, $op, $ident, $args) = @_;
my ($sql, @bind) = $self->sql_maker->$op(
my ($op, $ident, @args) =
$self->_select_args(@_);
- # my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $ident, [ $select, $cond, $rs_attrs, $rows, $offset ]);
- my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $ident, \@args);
+ # my ($sql, $prepared_bind) = $self->_gen_sql_bind($op, $ident, [ $select, $cond, $rs_attrs, $rows, $offset ]);
+ my ($sql, $prepared_bind) = $self->_gen_sql_bind($op, $ident, \@args);
$prepared_bind ||= [];
return wantarray
use strict;
use warnings;
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+use DBIx::Class::Carp;
use Scope::Guard ();
use Context::Preserve 'preserve_context';
use Try::Tiny;
__PACKAGE__->sql_limit_dialect ('RowNum');
__PACKAGE__->sql_quote_char ('"');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::Oracle');
+__PACKAGE__->datetime_parser_type('DateTime::Format::Oracle');
+
+sub __cache_queries_with_max_lob_parts { 2 }
=head1 NAME
=cut
-use base qw/DBIx::Class::Storage::DBI/;
-use mro 'c3';
-
-__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::Oracle');
-__PACKAGE__->datetime_parser_type('DateTime::Format::Oracle');
-
-sub __cache_queries_with_max_lob_parts { 2 }
-
sub _determine_supports_insert_returning {
my $self = shift;
my ($sql, $bind) = $self->next::method(@_);
- return ($sql, $bind) if $op ne 'select';
+ return ($sql, $bind) if $op eq 'insert';
- my @sql_part = split /\?/, $sql;
- my ($new_sql, @new_binds);
+ my $blob_bind_index;
+ for (0 .. $#$bind) {
+ $blob_bind_index->{$_} = 1 if $self->_is_lob_type(
+ $bind->[$_][0]{sqlt_datatype}
+ );
+ }
- foreach my $bound (@$bind) {
- my $data_type = $bound->[0]{sqlt_datatype}||'';
+ return ($sql, $bind) unless $blob_bind_index;
- if ($self->_is_lob_type($data_type)) {
- if (my ($col, $eq) = $sql_part[0] =~ /(?<=\s)([\w."]+)(\s*=\s*)$/) {
+ my (@sql_parts, $new_sql, @new_binds);
+
+ if ($op eq 'select' || $op eq 'delete') {
+ @sql_parts = split /\?/, $sql;
+ }
+ elsif ($op eq 'update') {
+ $self->throw_exception('Update with complex WHERE clauses currently not supported')
+ if $sql =~ /\bWHERE\b .+ \bWHERE\b/xs;
+
+ my ($set_part, $where_part) = $sql =~ /^ (.+?) ( \bWHERE\b .+) /xs;
+
+ my $set_bind_count = $set_part =~ y/?//;
+ @new_binds = splice @$bind, 0, $set_bind_count;
+
+ @sql_parts = split /\?/, $where_part;
+ $new_sql = $set_part;
+ }
+ else {
+ $self->throw_exception("Unsupported \$op: $op");
+ }
+
+ my $col_equality_re = qr/ (?<=\s) ([\w."]+) (\s*=\s*) $/x;
+
+ for my $b_idx (0 .. $#$bind) {
+ my $bound = $bind->[$b_idx];
+
+ if ($blob_bind_index->{$b_idx}) {
+ if (my ($col, $eq) = $sql_parts[0] =~ $col_equality_re) {
my $data = $bound->[1];
$data = "$data" if ref $data;
my @sql_frag;
for my $idx (0..$#parts) {
- push @sql_frag,
-"UTL_RAW.CAST_TO_VARCHAR2(RAWTOHEX(DBMS_LOB.SUBSTR($col, 2000, ".($idx*2000+1)."))) = ?";
+ push @sql_frag, sprintf (
+ 'UTL_RAW.CAST_TO_VARCHAR2(RAWTOHEX(DBMS_LOB.SUBSTR(%s, 2000, %d))) = ?',
+ $col, ($idx*2000 + 1),
+ );
}
my $sql_frag = '( ' . (join ' AND ', @sql_frag) . ' )';
- $sql_part[0] =~ s/(?<=\s)([\w."]+)(\s*=\s*)$/$sql_frag/;
+ $sql_parts[0] =~ s/$col_equality_re/$sql_frag/;
- $new_sql .= shift @sql_part;
+ $new_sql .= shift @sql_parts;
for my $idx (0..$#parts) {
push @new_binds, [
}
}
else {
- $new_sql .= shift(@sql_part) . '?';
+ $new_sql .= shift(@sql_parts) . '?';
push @new_binds, [
{
}
}
else {
- $new_sql .= shift(@sql_part) . '?';
+ $new_sql .= shift(@sql_parts) . '?';
push @new_binds, $bound;
}
}
- $new_sql .= join '', @sql_part;
+
+ if (@sql_parts > 1) {
+ carp "There are more placeholders than binds, this should not happen!";
+ @sql_parts = join ('?', @sql_parts);
+ }
+
+ $new_sql .= $sql_parts[0];
return ($new_sql, \@new_binds);
}
_per_row_update_delete
_dbh_execute_inserts_with_no_binds
_select_args_to_query
+ _gen_sql_bind
_svp_generate_name
_multipk_update_delete
_normalize_connect_info
$rs->create( { 'id' => $id, blob => "blob:$str", clob => "clob:$str" } )
} "inserted $size without dying";
+ my %kids = %{$schema->storage->_dbh->{CachedKids}};
my @objs = $rs->search({ blob => "blob:$str", clob => "clob:$str" })->all;
- is (@objs, 1, 'One row found matching on both LOBs');
+ is_deeply (
+ $schema->storage->_dbh->{CachedKids},
+ \%kids,
+ 'multi-part LOB equality query was not cached',
+ ) if $size eq 'large';
+ is @objs, 1, 'One row found matching on both LOBs';
ok (try { $objs[0]->blob }||'' eq "blob:$str", 'blob inserted/retrieved correctly');
ok (try { $objs[0]->clob }||'' eq "clob:$str", 'clob inserted/retrieved correctly');
- if ($size eq 'large') { # check that prepare_cached was NOT used
- my $sql = ${ $rs->search({ blob => "blob:$str", clob => "clob:$str" })
- ->as_query }->[0];
-
- ok((not exists $schema->storage->_dbh->{CachedKids}{$sql}),
- 'multi-part LOB equality query was not cached');
- }
-
@objs = $rs->search({ clob => { -like => 'clob:%' } })->all;
ok (@objs, 'rows found matching CLOB with a LIKE query');
- ok(my $subq = $rs->search({ blob => "blob:$str", clob => "clob:$str" })
- ->get_column('id')->as_query);
+ ok(my $subq = $rs->search(
+ { blob => "blob:$str", clob => "clob:$str" },
+ {
+ from => \ "(SELECT * FROM ${q}bindtype_test${q} WHERE ${q}id${q} != ?) ${q}me${q}",
+ bind => [ [ undef => 12345678 ] ],
+ }
+ )->get_column('id')->as_query);
@objs = $rs->search({ id => { -in => $subq } })->all;
is (@objs, 1, 'One row found matching on both LOBs as a subquery');
+
+ lives_ok {
+ $rs->search({ blob => "blob:$str", clob => "clob:$str" })
+ ->update({ blob => 'updated blob', clob => 'updated clob' });
+ } 'blob UPDATE with WHERE clause survived';
+
+ @objs = $rs->search({ blob => "updated blob", clob => 'updated clob' })->all;
+ is @objs, 1, 'found updated row';
+ ok (try { $objs[0]->blob }||'' eq "updated blob", 'blob updated/retrieved correctly');
+ ok (try { $objs[0]->clob }||'' eq "updated clob", 'clob updated/retrieved correctly');
+
+ lives_ok {
+ $rs->search({ blob => "updated blob", clob => "updated clob" })
+ ->delete;
+ } 'blob DELETE with WHERE clause survived';
+ @objs = $rs->search({ blob => "updated blob", clob => 'updated clob' })->all;
+ is @objs, 0, 'row deleted successfully';
}
$schema->storage->debug ($orig_debug);
use lib qw(t/lib);
use DBICTest;
use DBIC::SqlMakerTest;
+use DBIC::DebugObj;
{ # Fake storage driver for sqlite with autocast
package DBICTest::SQLite::AutoCast;
'tracks.last_updated_at' => { '!=', undef },
'tracks.last_updated_on' => { '<', 2009 },
'tracks.position' => 4,
- 'me.single_track' => \[ '= ?', [ single_track => [1, 2, 3 ] ] ],
+ 'me.single_track' => \[ '= ?', [ single_track => 1 ] ],
}, { join => 'tracks' });
-my $bind = [
- [ { sqlt_datatype => 'integer', dbic_colname => 'cdid' }
- => 5 ],
- [ { sqlt_datatype => 'integer', dbic_colname => 'single_track' }
- => [ 1, 2, 3] ],
- [ { sqlt_datatype => 'datetime', dbic_colname => 'tracks.last_updated_on' }
- => 2009 ],
- [ { sqlt_datatype => 'int', dbic_colname => 'tracks.position' }
- => 4 ],
-];
+my ($sql, @bind);
+my $debugobj = DBIC::DebugObj->new (\$sql, \@bind);
+my $storage = $schema->storage;
+my ($orig_debug, $orig_debugobj) = ($storage->debug, $storage->debugobj);
+$storage->debugobj ($debugobj);
+$storage->debug (1);
+# the quoting is a debugobj thing, not dbic-internals
+my $bind = [ map { "'$_'" } qw/
+ 5 1 2009 4
+/];
+
+$rs->all;
is_same_sql_bind (
- $rs->as_query,
- '(
+ $sql,
+ \@bind,
+ '
SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
FROM cd me
LEFT JOIN track tracks ON tracks.cd = me.cdid
AND tracks.last_updated_at IS NOT NULL
AND tracks.last_updated_on < ?
AND tracks.position = ?
- )',
+ ',
$bind,
'expected sql with casting off',
);
$schema->storage->auto_cast (1);
+$rs->all;
is_same_sql_bind (
- $rs->as_query,
- '(
+ $sql,
+ \@bind,
+ '
SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
FROM cd me
LEFT JOIN track tracks ON tracks.cd = me.cdid
AND tracks.last_updated_at IS NOT NULL
AND tracks.last_updated_on < CAST (? AS DateTime)
AND tracks.position = ?
- )',
+ ',
$bind,
'expected sql with casting on',
);
+$storage->debugobj ($orig_debugobj);
+$storage->debug ($orig_debug);
+
done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff