plain ::Storage::DBI
- ::Storage::DBI::sth was mistakenly marked/documented as public,
privatize and warn on deprecated use
+ - Massive overhaul of bind values/attributes handling - slightly
+ changes the output of as_query (should not cause compat issues)
* Fixes
- Fix ::Storage::DBI::* MRO problems on 5.8.x perls
my $attrs = shift @do_args;
my @bind = map { [ undef, $_ ] } @do_args;
- $self->_query_start($sql, @bind);
+ $self->_query_start($sql, \@bind);
$self->_get_dbh->do($sql, $attrs, @do_args);
- $self->_query_end($sql, @bind);
+ $self->_query_end($sql, \@bind);
}
return $self;
# 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, $extra_bind, $ident, $args) = @_;
+ my ($self, $op, $ident, $args) = @_;
- if( blessed $ident && $ident->isa("DBIx::Class::ResultSource") ) {
- $ident = $ident->from();
- }
+ my ($sql, @bind) = $self->sql_maker->$op(
+ blessed($ident) ? $ident->from : $ident,
+ @$args,
+ );
- my ($sql, @bind) = $self->sql_maker->$op($ident, @$args);
+ my (@final_bind, $colinfos);
+ my $resolve_bindinfo = sub {
+ $colinfos ||= $self->_resolve_column_info($ident);
+ if (my $col = $_[1]->{dbic_colname}) {
+ $_[1]->{sqlt_datatype} ||= $colinfos->{$col}{data_type}
+ if $colinfos->{$col}{data_type};
+ $_[1]->{sqlt_size} ||= $colinfos->{$col}{size}
+ if $colinfos->{$col}{size};
+ }
+ $_[1];
+ };
- unshift(@bind,
- map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind)
- if $extra_bind;
- return ($sql, \@bind);
+ for my $e (@{$args->[2]{bind}||[]}, @bind) {
+ push @final_bind, [ do {
+ if (ref $e ne 'ARRAY') {
+ ({}, $e)
+ }
+ elsif (! defined $e->[0]) {
+ ({}, $e->[1])
+ }
+ elsif (ref $e->[0] eq 'HASH') {
+ (
+ (first { $e->[0]{$_} } qw/dbd_attrs sqlt_datatype/) ? $e->[0] : $self->$resolve_bindinfo($e->[0]),
+ $e->[1]
+ )
+ }
+ elsif (ref $e->[0] eq 'SCALAR') {
+ ( { sqlt_datatype => ${$e->[0]} }, $e->[1] )
+ }
+ else {
+ ( $self->$resolve_bindinfo({ dbic_colname => $e->[0] }), $e->[1] )
+ }
+ }];
+ }
+
+ ($sql, \@final_bind);
}
+sub _format_for_trace {
+ #my ($self, $bind) = @_;
-sub _fix_bind_params {
- my ($self, @bind) = @_;
+ ### Turn @bind from something like this:
+ ### ( [ "artist", 1 ], [ \%attrs, 3 ] )
+ ### to this:
+ ### ( "'1'", "'3'" )
- ### Turn @bind from something like this:
- ### ( [ "artist", 1 ], [ "cdid", 1, 3 ] )
- ### to this:
- ### ( "'1'", "'1'", "'3'" )
- return
- map {
- if ( defined( $_ && $_->[1] ) ) {
- map { qq{'$_'}; } @{$_}[ 1 .. $#$_ ];
- }
- else { q{NULL}; }
- } @bind;
+ map {
+ defined( $_ && $_->[1] )
+ ? qq{'$_->[1]'}
+ : q{NULL}
+ } @{$_[1] || []};
}
sub _query_start {
- my ( $self, $sql, @bind ) = @_;
-
- if ( $self->debug ) {
- @bind = $self->_fix_bind_params(@bind);
+ my ( $self, $sql, $bind ) = @_;
- $self->debugobj->query_start( $sql, @bind );
- }
+ $self->debugobj->query_start( $sql, $self->_format_for_trace($bind) )
+ if $self->debug;
}
sub _query_end {
- my ( $self, $sql, @bind ) = @_;
+ my ( $self, $sql, $bind ) = @_;
- if ( $self->debug ) {
- @bind = $self->_fix_bind_params(@bind);
- $self->debugobj->query_end( $sql, @bind );
- }
+ $self->debugobj->query_end( $sql, $self->_format_for_trace($bind) )
+ if $self->debug;
}
-sub _dbh_execute {
- my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
-
- my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
+my $sba_compat;
+sub _dbi_attrs_for_bind {
+ my ($self, $ident, $bind) = @_;
- $self->_query_start( $sql, @$bind );
+ if (! defined $sba_compat) {
+ $self->_determine_driver;
+ $sba_compat = $self->can('source_bind_attributes') == \&source_bind_attributes
+ ? 0
+ : 1
+ ;
+ }
- my $sth = $self->_sth($sql,$op);
+ my $sba_attrs;
+ if ($sba_compat) {
+ my $class = ref $self;
+ carp_unique (
+ "The source_bind_attributes() override in $class relies on a deprecated codepath. "
+ .'You are strongly advised to switch your code to override bind_attribute_by_datatype() '
+ .'instead. This legacy compat shim will also disappear some time before DBIC 0.09'
+ );
- my $placeholder_index = 1;
+ my $sba_attrs = $self->source_bind_attributes
+ }
- foreach my $bound (@$bind) {
- my $attributes = {};
- my($column_name, @data) = @$bound;
+ my @attrs;
- if ($bind_attributes) {
- $attributes = $bind_attributes->{$column_name}
- if defined $bind_attributes->{$column_name};
+ for (map { $_->[0] } @$bind) {
+ push @attrs, do {
+ if ($_->{dbd_attrs}) {
+ $_->{dbd_attrs}
+ }
+ elsif($_->{sqlt_datatype}) {
+ $self->bind_attribute_by_data_type($_->{sqlt_datatype}) || undef;
+ }
+ elsif ($sba_attrs and $_->{dbic_colname}) {
+ $sba_attrs->{$_->{dbic_colname}} || undef;
+ }
+ else {
+ undef; # always push something at this position
+ }
}
+ }
- foreach my $data (@data) {
- my $ref = ref $data;
+ return \@attrs;
+}
- 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;
- }
+sub _execute {
+ my ($self, $op, $ident, @args) = @_;
+
+ my ($sql, $bind) = $self->_prep_for_execute($op, $ident, \@args);
+
+ shift->dbh_do( # retry over disconnects
+ '_dbh_execute',
+ $sql,
+ $bind,
+ $self->_dbi_attrs_for_bind($ident, $bind)
+ );
+}
- $sth->bind_param($placeholder_index++, $data, $attributes);
+sub _dbh_execute {
+ my ($self, undef, $sql, $bind, $bind_attrs) = @_;
+
+ $self->_query_start( $sql, $bind );
+ my $sth = $self->_sth($sql);
+
+ for my $i (0 .. $#$bind) {
+ if (ref $bind->[$i][1] eq 'SCALAR') { # any scalarrefs are assumed to be bind_inouts
+ $sth->bind_param_inout(
+ $i + 1, # bind params counts are 1-based
+ $bind->[$i][1],
+ $bind->[$i][0]{dbd_size} || $self->_max_column_bytesize($bind->[$i][0]), # size
+ $bind_attrs->[$i],
+ );
+ }
+ else {
+ $sth->bind_param(
+ $i + 1,
+ (ref $bind->[$i][1] and overload::Method($bind->[$i][1], '""'))
+ ? "$bind->[$i][1]"
+ : $bind->[$i][1]
+ ,
+ $bind_attrs->[$i],
+ );
}
}
$sth->errstr || $sth->err || 'Unknown error: execute() returned false, but error flags were not set...'
) if !$rv;
- $self->_query_end( $sql, @$bind );
+ $self->_query_end( $sql, $bind );
return (wantarray ? ($rv, $sth, @$bind) : $rv);
}
-sub _execute {
- my $self = shift;
- $self->dbh_do('_dbh_execute', @_); # retry over disconnects
-}
-
sub _prefetch_autovalues {
my ($self, $source, $to_insert) = @_;
}
}
- my $bind_attributes = $self->source_bind_attributes($source);
-
- my ($rv, $sth) = $self->_execute('insert' => [], $source, $bind_attributes, $to_insert, $sqla_opts);
+ my ($rv, $sth) = $self->_execute('insert', $source, $to_insert, $sqla_opts);
my %returned_cols;
}
my ($sql, $bind) = $self->_prep_for_execute (
- 'insert', undef, $source, [\%colvalues]
+ 'insert', $source, [\%colvalues]
);
if (! @$bind) {
# scope guard
my $guard = $self->txn_scope_guard;
- $self->_query_start( $sql, @$bind ? [ dummy => '__BULK_INSERT__' ] : () );
+ $self->_query_start( $sql, @$bind ? [[undef => '__BULK_INSERT__' ]] : () );
my $sth = $self->_sth($sql);
my $rv = do {
if (@$bind) {
}
};
- $self->_query_end( $sql, @$bind ? [ dummy => '__BULK_INSERT__' ] : () );
+ $self->_query_end( $sql, @$bind ? [[ undef => '__BULK_INSERT__' ]] : () );
$guard->commit;
## This must be an arrayref, else nothing works!
my $tuple_status = [];
- ## Get the bind_attributes, if any exist
- my $bind_attributes = $self->source_bind_attributes($source);
-
- ## Bind the values and execute
- my $placeholder_index = 1;
+ # $bind contains colnames as keys and dbic-col-index as values
+ my $bind_attrs = $self->_dbi_attrs_for_bind($source, $bind);
- foreach my $bound (@$bind) {
-
- my $attributes = {};
- my ($column_name, $data_index) = @$bound;
-
- if( $bind_attributes ) {
- $attributes = $bind_attributes->{$column_name}
- if defined $bind_attributes->{$column_name};
- }
-
- my @data = map { $_->[$data_index] } @$data;
+ # Bind the values by column slices
+ for my $i (0 .. $#$bind) {
+ my $dbic_data_index = $bind->[$i][1];
$sth->bind_param_array(
- $placeholder_index,
- [@data],
- (%$attributes ? $attributes : ()),
+ $i+1, # DBI bind indexes are 1-based
+ [ map { $_->[$dbic_data_index] } @$data ],
+ defined $bind_attrs->[$i] ? $bind_attrs->[$i] : (), # some DBDs throw up when given an undef
);
- $placeholder_index++;
}
my ($rv, $err);
}
sub update {
- my ($self, $source, @args) = @_;
-
- my $bind_attrs = $self->source_bind_attributes($source);
-
- return $self->_execute('update' => [], $source, $bind_attrs, @args);
+ #my ($self, $source, @args) = @_;
+ shift->_execute('update', @_);
}
sub delete {
- my ($self, $source, @args) = @_;
-
- my $bind_attrs = $self->source_bind_attributes($source);
-
- return $self->_execute('delete' => [], $source, $bind_attrs, @args);
+ #my ($self, $source, @args) = @_;
+ shift->_execute('delete', @_);
}
# We were sent here because the $rs contains a complex search
sub _select_args_to_query {
my $self = shift;
- # my ($op, $bind, $ident, $bind_attrs, $select, $cond, $rs_attrs, $rows, $offset)
+ # my ($op, $ident, $select, $cond, $rs_attrs, $rows, $offset)
# = $self->_select_args($ident, $select, $cond, $attrs);
- my ($op, $bind, $ident, $bind_attrs, @args) =
+ my ($op, $ident, @args) =
$self->_select_args(@_);
- # my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $bind, $ident, [ $select, $cond, $rs_attrs, $rows, $offset ]);
- my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $bind, $ident, \@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);
$prepared_bind ||= [];
return wantarray
- ? ($sql, $prepared_bind, $bind_attrs)
+ ? ($sql, $prepared_bind)
: \[ "($sql)", @$prepared_bind ]
;
}
,
};
- # calculate bind_attrs before possible $ident mangling
- my $bind_attrs = {};
- for my $alias (keys %$alias2source) {
- my $bindtypes = $self->source_bind_attributes ($alias2source->{$alias}) || {};
- for my $col (keys %$bindtypes) {
-
- my $fqcn = join ('.', $alias, $col);
- $bind_attrs->{$fqcn} = $bindtypes->{$col} if $bindtypes->{$col};
-
- # Unqialified column names are nice, but at the same time can be
- # rather ambiguous. What we do here is basically go along with
- # the loop, adding an unqualified column slot to $bind_attrs,
- # alongside the fully qualified name. As soon as we encounter
- # another column by that name (which would imply another table)
- # we unset the unqualified slot and never add any info to it
- # to avoid erroneous type binding. If this happens the users
- # only choice will be to fully qualify his column name
-
- if (exists $bind_attrs->{$col}) {
- $bind_attrs->{$col} = {};
- }
- else {
- $bind_attrs->{$col} = $bind_attrs->{$fqcn};
- }
- }
- }
-
# Sanity check the attributes (SQLMaker does it too, but
# in case of a software_limit we'll never reach there)
if (defined $attrs->{offset}) {
$self->throw_exception('A supplied offset attribute must be a non-negative integer')
if ( $attrs->{offset} =~ /\D/ or $attrs->{offset} < 0 );
}
- $attrs->{offset} ||= 0;
if (defined $attrs->{rows}) {
$self->throw_exception("The rows attribute must be a positive integer if present")
= $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
}
elsif (! $attrs->{software_limit} ) {
- push @limit, $attrs->{rows}, $attrs->{offset};
+ push @limit, (
+ $attrs->{rows} || (),
+ $attrs->{offset} || (),
+ );
}
# try to simplify the joinmap further (prune unreferenced type-single joins)
# invoked, and that's just bad...
###
- return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $attrs, @limit);
+ return ('select', $ident, $select, $where, $attrs, @limit);
}
# Returns a counting SELECT for a simple count
return { count => '*' };
}
-
sub source_bind_attributes {
- my ($self, $source) = @_;
-
- my $bind_attributes;
-
- my $colinfo = $source->columns_info;
-
- for my $col (keys %$colinfo) {
- if (my $dt = $colinfo->{$col}{data_type} ) {
- $bind_attributes->{$col} = $self->bind_attribute_by_data_type($dt)
- }
- }
-
- return $bind_attributes;
+ shift->throw_exception(
+ 'source_bind_attributes() was never meant to be a callable public method - '
+ .'please contact the DBIC dev-team and describe your use case so that a reasonable '
+ .'solution can be provided'
+ ."\nhttp://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT"
+ );
}
=head2 select
=cut
sub is_datatype_numeric {
- my ($self, $dt) = @_;
+ #my ($self, $dt) = @_;
- return 0 unless $dt;
+ return 0 unless $_[1];
- return $dt =~ /^ (?:
+ $_[1] =~ /^ (?:
numeric | int(?:eger)? | (?:tiny|small|medium|big)int | dec(?:imal)? | real | float | double (?: \s+ precision)? | (?:big)?serial
) $/ix;
}
# 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 ($self, $attr) = @_;
- my $inf = $source->column_info($col);
- return $inf->{_max_bytesize} ||= do {
+ my $max_size;
- my $max_size;
+ if ($attr->{sqlt_datatype}) {
+ my $data_type = lc($attr->{sqlt_datatype});
- if (my $data_type = $inf->{data_type}) {
- $data_type = lc($data_type);
+ if ($attr->{sqlt_size}) {
# String/sized-binary types
- if ($data_type =~ /^(?:l?(?:var)?char(?:acter)?(?:\s*varying)?
- |(?:var)?binary(?:\s*varying)?|raw)\b/x
+ if ($data_type =~ /^(?:
+ l? (?:var)? char(?:acter)? (?:\s*varying)?
+ |
+ (?:var)? binary (?:\s*varying)?
+ |
+ raw
+ )\b/x
) {
- $max_size = $inf->{size};
+ $max_size = $attr->{sqlt_size};
}
# Other charset/unicode types, assume scale of 4
- elsif ($data_type =~ /^(?:national\s*character(?:\s*varying)?|nchar
- |univarchar
- |nvarchar)\b/x
+ 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 = $attr->{sqlt_size} * 4;
}
}
- $max_size ||= $self->_get_dbh->{LongReadLen} || 8000;
- };
+ if (!$max_size and !$self->_is_lob_type($data_type)) {
+ $max_size = 100 # for all other (numeric?) datatypes
+ }
+ }
+
+ $max_size || $self->_dbic_connect_attributes->{LongReadLen} || $self->_get_dbh->{LongReadLen} || 8000;
}
# Determine if a data_type is some type of BLOB
-# FIXME: these regexes are expensive, result of these checks should be cached in
-# the column_info .
sub _is_lob_type {
my ($self, $data_type) = @_;
$data_type && ($data_type =~ /lob|bfile|text|image|bytea|memo/i
$self->_identity_method('@@identity');
}
-sub source_bind_attributes {
- my $self = shift;
- my ($source) = @_;
-
- my $bind_attributes = $self->next::method(@_);
+# work around a bug in the ADO driver - use the max VARCHAR size for all
+# binds that do not specify one via bind_attributes_by_data_type()
+sub _dbi_attrs_for_bind {
+ my $attrs = shift->next::method(@_);
- foreach my $column ($source->columns) {
- $bind_attributes->{$column}{ado_size} ||= 8000; # max VARCHAR
+ for (@$attrs) {
+ $_->{ado_size} ||= 8000 if $_;
}
- return $bind_attributes;
+ $attrs;
}
sub bind_attribute_by_data_type {
sub _prep_for_execute {
my $self = shift;
- my ($op, $extra_bind, $ident, $args) = @_;
my ($sql, $bind) = $self->next::method (@_);
# gets skippeed.
if ($self->auto_cast && @$bind) {
my $new_sql;
- my @sql_part = split /\?/, $sql;
- my $col_info = $self->_resolve_column_info($ident,[ map $_->[0], @$bind ]);
-
- foreach my $bound (@$bind) {
- my $col = $bound->[0];
- my $type = $self->_native_data_type($col_info->{$col}{data_type});
-
- foreach my $data (@{$bound}[1..$#$bound]) {
- $new_sql .= shift(@sql_part) .
- ($type ? "CAST(? AS $type)" : '?');
- }
+ my @sql_part = split /\?/, $sql, scalar @$bind + 1;
+ for (@$bind) {
+ my $cast_type = $self->_native_data_type($_->[0]{sqlt_datatype});
+ $new_sql .= shift(@sql_part) . ($cast_type ? "CAST(? AS $cast_type)" : '?');
}
- $new_sql .= join '', @sql_part;
- $sql = $new_sql;
+ $sql = $new_sql . shift @sql_part;
}
return ($sql, $bind);
sub _prep_for_execute {
my $self = shift;
- my ($op, $extra_bind, $ident, $args) = @_;
+ my ($op, $ident, $args) = @_;
# cast MONEY values properly
if ($op eq 'insert' || $op eq 'update') {
my $self = shift;
my ($op) = @_;
- my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
+ my ($rv, $sth, @bind) = $self->next::method(@_);
if ($op eq 'insert') {
my ($sql, $bind) = $self->next::method(@_);
# stringify bind args, quote via $dbh, and manually insert
- #my ($op, $extra_bind, $ident, $args) = @_;
- my $ident = $_[2];
+ #my ($op, $ident, $args) = @_;
+ my $ident = $_[1];
my @sql_part = split /\?/, $sql;
my $new_sql;
- my $col_info = $self->_resolve_column_info($ident, [ map $_->[0], @$bind ]);
+ my $col_info = $self->_resolve_column_info(
+ $ident, [ map { $_->[0]{dbic_colname} || () } @$bind ]
+ );
- foreach my $bound (@$bind) {
- my $col = shift @$bound;
+ for (@$bind) {
+ my $datatype = $col_info->{ $_->[0]{dbic_colname}||'' }{data_type};
- my $datatype = $col_info->{$col}{data_type};
+ my $data = (ref $_->[1]) ? "$_->[1]" : $_->[1]; # always stringify
- foreach my $data (@$bound) {
- $data = ''.$data if ref $data;
+ $data = $self->_prep_interpolated_value($datatype, $data)
+ if $datatype;
- $data = $self->_prep_interpolated_value($datatype, $data)
- if $datatype;
+ $data = $self->_get_dbh->quote($data)
+ unless $self->interpolate_unquoted($datatype, $data);
- $data = $self->_dbh->quote($data)
- unless $self->interpolate_unquoted($datatype, $data);
-
- $new_sql .= shift(@sql_part) . $data;
- }
+ $new_sql .= shift(@sql_part) . $data;
}
+
$new_sql .= join '', @sql_part;
return ($new_sql, []);
my $self = shift;
my ( $source, $to_insert ) = @_;
- my $bind_attributes = $self->source_bind_attributes( $source );
- my ( undef, $sth ) = $self->_execute( 'insert' => [], $source, $bind_attributes, $to_insert );
+ my ( undef, $sth ) = $self->_execute( 'insert', $source, $to_insert );
#store the identity here since @@IDENTITY is connection global and this prevents
#possibility that another insert to a different table overwrites it for this resultsource
}
sub _dbh_execute {
- my $self = shift;
- my ($dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
+ my ($self, $dbh, $sql, @args) = @_;
my (@res, $tried);
my $want = wantarray;
my $next = $self->next::can;
do {
try {
- my $exec = sub { $self->$next($dbh, $op, $extra_bind, $ident, $bind_attributes, @args) };
+ my $exec = sub { $self->$next($dbh, $sql, @args) };
if (!defined $want) {
$exec->();
if (! $tried and $_ =~ /ORA-01003/) {
# ORA-01003: no statement parsed (someone changed the table somehow,
# invalidating your cursor.)
- my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
delete $dbh->{CachedKids}{$sql};
}
else {
);
}
-=head2 source_bind_attributes
-
-Handle LOB types in Oracle. Under a certain size (4k?), you can get away
-with the driver assuming your input is the deprecated LONG type if you
-encode it as a hex string. That ain't gonna fly at larger values, where
-you'll discover you have to do what this does.
-
-This method had to be overridden because we need to set ora_field to the
-actual column, and that isn't passed to the call (provided by Storage) to
-bind_attribute_by_data_type.
-
-According to L<DBD::Oracle>, the ora_field isn't always necessary, but
-adding it doesn't hurt, and will save your bacon if you're modifying a
-table with more than one LOB column.
-
-=cut
-
-sub source_bind_attributes
-{
- require DBD::Oracle;
- my $self = shift;
- my($source) = @_;
-
- my %bind_attributes = %{ $self->next::method(@_) };
-
- foreach my $column ($source->columns) {
- my %column_bind_attrs = %{ $bind_attributes{$column} || {} };
+### Note originally by Ron "Quinn" Straight <quinnfazigu@gmail.org>
+### http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/DBIx-Class.git;a=commitdiff;h=5db2758de644d53e07cd3e05f0e9037bf40116fc
+#
+# Handle LOB types in Oracle. Under a certain size (4k?), you can get away
+# with the driver assuming your input is the deprecated LONG type if you
+# encode it as a hex string. That ain't gonna fly at larger values, where
+# you'll discover you have to do what this does.
+#
+# This method had to be overridden because we need to set ora_field to the
+# actual column, and that isn't passed to the call (provided by Storage) to
+# bind_attribute_by_data_type.
+#
+# According to L<DBD::Oracle>, the ora_field isn't always necessary, but
+# adding it doesn't hurt, and will save your bacon if you're modifying a
+# table with more than one LOB column.
+#
+sub _dbi_attrs_for_bind {
+ my ($self, $ident, $bind) = @_;
+ my $attrs = $self->next::method($ident, $bind);
+
+ for my $i (0 .. $#$attrs) {
+ if (keys %{$attrs->[$i]||{}} and my $col = $bind->[$i][0]{dbic_colname}) {
+ $attrs->[$i]{ora_field} = $col;
+ }
+ }
- my $data_type = $source->column_info($column)->{data_type};
+ $attrs;
+}
- if ($self->_is_lob_type($data_type)) {
- if ($DBD::Oracle::VERSION eq '1.23') {
- $self->throw_exception(
-"BLOB/CLOB support in DBD::Oracle == 1.23 is broken, use an earlier or later ".
-"version.\n\nSee: https://rt.cpan.org/Public/Bug/Display.html?id=46016\n"
- );
- }
+my $dbd_loaded;
+sub bind_attribute_by_data_type {
+ my ($self, $dt) = @_;
+
+ $dbd_loaded ||= do {
+ require DBD::Oracle;
+ if ($DBD::Oracle::VERSION eq '1.23') {
+ $self->throw_exception(
+ "BLOB/CLOB support in DBD::Oracle == 1.23 is broken, use an earlier or later ".
+ "version.\n\nSee: https://rt.cpan.org/Public/Bug/Display.html?id=46016\n"
+ );
+ }
+ 1;
+ };
- $column_bind_attrs{'ora_type'} = $self->_is_text_lob_type($data_type)
+ if ($self->_is_lob_type($dt)) {
+ return {
+ ora_type => $self->_is_text_lob_type($dt)
? DBD::Oracle::ORA_CLOB()
: DBD::Oracle::ORA_BLOB()
- ;
- $column_bind_attrs{'ora_field'} = $column;
- }
-
- $bind_attributes{$column} = \%column_bind_attrs;
+ };
}
-
- return \%bind_attributes;
}
sub _svp_begin {
svp_release
relname_to_table_alias
_dbh_last_insert_id
- _fix_bind_params
_default_dbi_connect_attributes
_dbi_connect_info
_dbic_connect_attributes
auto_savepoint
+ _query_start
_query_end
+ _format_for_trace
+ _dbi_attrs_for_bind
bind_attribute_by_data_type
transaction_depth
_dbh
_select_args
_dbh_execute_array
_sql_maker
- _query_start
_per_row_update_delete
_dbh_begin_work
_dbh_execute_inserts_with_no_binds
_select_args_to_query
_svp_generate_name
_multipk_update_delete
- source_bind_attributes
_normalize_connect_info
_parse_connect_do
_dbh_commit
_arm_global_destructor
_verify_pid
+ source_bind_attributes
+
get_use_dbms_capability
set_use_dbms_capability
get_dbms_capability
$self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
}
+sub bind_attribute_by_data_type {
+ $_[1] =~ /^ (?: int(?:eger)? | (?:tiny|small|medium|big)int ) $/ix
+ ? do { require DBI; DBI::SQL_INTEGER() }
+ : undef
+ ;
+}
+
=head2 connect_call_use_foreign_keys
Used as:
sub _prep_for_execute {
my $self = shift;
- my ($op, $extra_bind, $ident, $args) = @_;
+ my ($op, $ident, $args) = @_;
my ($sql, $bind) = $self->next::method (@_);
my $table = blessed $ident ? $ident->from : $ident;
my $bind_info = $self->_resolve_column_info(
- $ident, [map $_->[0], @{$bind}]
+ $ident, [map { $_->[0]{dbic_colname} || () } @{$bind}]
);
my $bound_identity_col =
first { $bind_info->{$_}{is_auto_increment} }
my $self = shift;
my ($op) = @_;
- my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
+ my ($rv, $sth, @bind) = $self->next::method(@_);
if ($op eq 'insert') {
$self->_identity($sth->fetchrow_array);
}
);
- my @bind = do {
- my $idx = 0;
- map [ $_, $idx++ ], @source_columns;
- };
+ my @bind = map { [ $source_columns[$_] => $_ ] } (0 .. $#source_columns);
$self->_execute_array(
$source, $sth, \@bind, \@source_columns, \@new_data, sub {
START WITH name = ?
CONNECT BY parentid = PRIOR artistid
)',
- [ [ name => 'root'] ],
+ [ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
+ => 'root'] ],
);
is_deeply (
[ $rs->get_column ('name')->all ],
START WITH name = ?
CONNECT BY parentid = PRIOR artistid
)',
- [ [ name => 'root'] ],
+ [ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
+ => 'root'] ],
);
is( $rs->count, 5, 'Connect By count ok' );
CONNECT BY parentid = PRIOR artistid
ORDER SIBLINGS BY name DESC
)',
- [ [ name => 'root'] ],
+ [ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
+ => 'root'] ],
);
is_deeply (
START WITH name = ?
CONNECT BY parentid = PRIOR artistid
)',
- [ [ name => 'root'] ],
+ [ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
+ => 'root'] ],
);
is_deeply(
START WITH me.name = ?
CONNECT BY parentid = PRIOR artistid
)',
- [ [ 'cds.title' => '%cd' ], [ 'me.name' => 'root' ] ],
+ [
+ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'cds.title', 'sqlt_size' => 100 }
+ => '%cd'],
+ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'me.name', 'sqlt_size' => 100 }
+ => 'root'],
+ ],
);
is_deeply(
START WITH me.name = ?
CONNECT BY parentid = PRIOR artistid
)',
- [ [ 'cds.title' => '%cd' ], [ 'me.name' => 'root' ] ],
+ [
+ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'cds.title', 'sqlt_size' => 100 }
+ => '%cd'],
+ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'me.name', 'sqlt_size' => 100 }
+ => 'root'],
+ ],
);
is( $rs->count, 1, 'Connect By with a join; count ok' );
CONNECT BY parentid = PRIOR artistid
ORDER BY LEVEL ASC, name ASC
)',
- [ [ name => 'root' ] ],
+ [
+ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
+ => 'root'],
+ ],
);
) me
WHERE ROWNUM <= 2
)',
- [ [ name => 'root' ] ],
+ [
+ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
+ => 'root'],
+ ],
);
is_deeply (
WHERE ROWNUM <= 2
) me
)',
- [ [ name => 'root' ] ],
+ [
+ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
+ => 'root'],
+ ],
);
is( $rs->count, 2, 'Connect By; LIMIT count ok' );
GROUP BY( rank + ? ) HAVING count(rank) < ?
)',
[
- [ __cbind => 3 ],
- [ name => 'root' ],
- [ __gbind => 1 ],
- [ cnt => 2 ]
+ [ { dbic_colname => '__cbind' }
+ => 3 ],
+ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
+ => 'root'],
+ [ { dbic_colname => '__gbind' }
+ => 1 ],
+ [ { dbic_colname => 'cnt' }
+ => 2 ],
],
);
START WITH name = ?
CONNECT BY NOCYCLE parentid = PRIOR artistid
)',
- [ [ name => 'cycle-root'] ],
+ [
+ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
+ => 'cycle-root'],
+ ],
);
is_deeply (
[ $rs->get_column ('name')->all ],
START WITH name = ?
CONNECT BY NOCYCLE parentid = PRIOR artistid
)',
- [ [ name => 'cycle-root'] ],
+ [
+ [ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
+ => 'cycle-root'],
+ ],
);
is( $rs->count, 4, 'Connect By Nocycle count ok' );
);
my ($sql, @bind) = @${$owners->page(3)->as_query};
- is_deeply (
+ is_same_bind (
\@bind,
[
- $dialect eq 'Top' ? [ test => 'xxx' ] : (), # the extra re-order bind
- ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 # double because of the prefetch subq
+ $dialect eq 'Top' ? [ { dbic_colname => 'test' } => 'xxx' ] : (), # the extra re-order bind
+ (map {
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
+ => 'somebogusstring' ],
+ [ { dbic_colname => 'test' }
+ => 'xxx' ],
+ } (1,2)), # double because of the prefetch subq
],
);
);
($sql, @bind) = @${$books->page(3)->as_query};
- is_deeply (
+ is_same_bind (
\@bind,
[
# inner
- [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ],
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
+ => 'wiggle' ],
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
+ => 'woggle' ],
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ],
+ [ { dbic_colname => 'test' }
+ => '1' ],
+
# outer
- [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ],
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
+ => 'wiggle' ],
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
+ => 'woggle' ],
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ],
],
);
'tracks.last_updated_at' => { '!=', undef },
'tracks.last_updated_on' => { '<', 2009 },
'tracks.position' => 4,
- 'tracks.single_track' => \[ '= ?', [ single_track => [1, 2, 3 ] ] ],
+ 'me.single_track' => \[ '= ?', [ single_track => [1, 2, 3 ] ] ],
}, { join => 'tracks' });
my $bind = [
- [ cdid => 5 ],
- [ 'tracks.last_updated_on' => 2009 ],
- [ 'tracks.position' => 4 ],
- [ 'single_track' => [ 1, 2, 3] ],
+ [ { 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 ],
];
is_same_sql_bind (
LEFT JOIN track tracks ON tracks.cd = me.cdid
WHERE
cdid > ?
+ AND me.single_track = ?
AND tracks.last_updated_at IS NOT NULL
AND tracks.last_updated_on < ?
AND tracks.position = ?
- AND tracks.single_track = ?
)',
$bind,
'expected sql with casting off',
LEFT JOIN track tracks ON tracks.cd = me.cdid
WHERE
cdid > CAST(? AS INT)
+ AND me.single_track = CAST(? AS INT)
AND tracks.last_updated_at IS NOT NULL
AND tracks.last_updated_on < CAST (? AS DateTime)
AND tracks.position = ?
- AND tracks.single_track = CAST(? AS INT)
)',
$bind,
'expected sql with casting on',
LIMIT 3 OFFSET 8
) tracks
)',
- [ [ position => 1 ], [ position => 2 ] ],
+ [
+ [ { sqlt_datatype => 'int', dbic_colname => 'position' }
+ => 1 ],
+ [ { sqlt_datatype => 'int', dbic_colname => 'position' }
+ => 2 ],
+ ],
'count_rs db-side limit applied',
);
}
LIMIT 3 OFFSET 4
) cds
)',
- [ [ 'tracks.position' => 1 ], [ 'tracks.position' => 2 ] ],
+ [
+ [ { sqlt_datatype => 'int', dbic_colname => 'tracks.position' }
+ => 1 ],
+ [ { sqlt_datatype => 'int', dbic_colname => 'tracks.position' }
+ => 2 ],
+ ],
'count_rs db-side limit applied',
);
}
HAVING newest_cd_year = ?
) me
)',
- [ [ 'newest_cd_year' => '2001' ],],
+ [ [ { dbic_colname => 'newest_cd_year' }
+ => '2001' ] ],
'count with having clause keeps sql as alias',
);
GROUP BY cds.cdid
) cds
)',
- [ map { [ 'tracks.position' => $_ ] } (1, 2) ],
+ [ map { [ { sqlt_datatype => 'int', dbic_colname => 'tracks.position' } => $_ ] } (1, 2) ],
);
}
)
genre
)',
- [ [ 'genre.name' => 'emo' ] ],
+ [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'genre.name' }
+ => 'emo' ]
+ ],
);
}
LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid
WHERE lyrics.lyric_id IS NULL AND (position = ? OR position = ?)
)',
- [ map { [ position => $_ ] } (1, 2) ],
+ [ map { [ { sqlt_datatype => 'int', dbic_colname => 'position' } => $_ ] } (1, 2) ],
);
}
'hello' => { data_type => 'integer' },
'goodbye' => { data_type => 'integer' },
'sensors' => { data_type => 'character', size => 10 },
- 'read_count' => { data_type => 'integer', is_nullable => 1 },
+ 'read_count' => { data_type => 'int', is_nullable => 1 },
);
__PACKAGE__->set_primary_key(qw/foo bar hello goodbye/);
'+columns' => { sibling_count => $cdrs->search(
{
'siblings.artist' => { -ident => 'me.artist' },
- 'siblings.cdid' => { '!=' => ['-and', { -ident => 'me.cdid' }, 'bogus condition'] },
+ 'siblings.cdid' => { '!=' => ['-and', { -ident => 'me.cdid' }, 23414] },
}, { alias => 'siblings' },
)->count_rs->as_query,
},
[
# subselect
- [ 'siblings.cdid' => 'bogus condition' ],
- [ 'me.artist' => 2 ],
+ [ { sqlt_datatype => 'integer', dbic_colname => 'siblings.cdid' }
+ => 23414 ],
+
+ [ { sqlt_datatype => 'integer', dbic_colname => 'me.artist' }
+ => 2 ],
# outher WHERE
- [ 'me.artist' => 2 ],
+ [ { sqlt_datatype => 'integer', dbic_colname => 'me.artist' }
+ => 2 ],
],
'Expected SQL on correlated realiased subquery'
);
# first add a lone non-as-ed select
# it should be reordered to appear at the end without throwing prefetch/bind off
-$c_rs = $c_rs->search({}, { '+select' => \[ 'me.cdid + ?', [ __add => 1 ] ] });
+$c_rs = $c_rs->search({}, { '+select' => \[ 'me.cdid + ?', [ \ 'inTEger' => 1 ] ] });
# now add an unbalanced select/as pair
$c_rs = $c_rs->search ({}, {
[
# first subselect
- [ 'siblings.cdid' => 'bogus condition' ],
- [ 'me.artist' => 2 ],
+ [ { sqlt_datatype => 'integer', dbic_colname => 'siblings.cdid' }
+ => 23414 ],
+
+ [ { sqlt_datatype => 'integer', dbic_colname => 'me.artist' }
+ => 2 ],
# second subselect
- [ 'me.artist' => 2 ],
+ [ { sqlt_datatype => 'integer', dbic_colname => 'me.artist' }
+ => 2 ],
# the addition
- [ __add => 1 ],
+ [ { sqlt_datatype => 'inTEger' }
+ => 1 ],
# outher WHERE
- [ 'me.artist' => 2 ],
+ [ { sqlt_datatype => 'integer', dbic_colname => 'me.artist' }
+ => 2 ],
],
'Expected SQL on correlated realiased subquery'
);
JOIN track tracks ON tracks.cd = cds.cdid
WHERE ( me.artistid = ? )
)',
- [ [ 'me.artistid' => 4 ] ],
+ [ [ { sqlt_datatype => 'integer', dbic_colname => 'me.artistid' }
+ => 4 ] ],
);
)
me
)',
- [ map { [ 'me.cd' => $_] } ($cd_rs->get_column ('cdid')->all) ],
+ [ map { [ { sqlt_datatype => 'integer', dbic_colname => 'me.cd' }
+ => $_ ] } ($cd_rs->get_column ('cdid')->all) ],
'count() query generated expected SQL',
);
JOIN cd cd ON cd.cdid = me.cd
WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
)',
- [ map { [ 'me.cd' => $_] } ( ($cd_rs->get_column ('cdid')->all) x 2 ) ],
+ [ map { [ { sqlt_datatype => 'integer', dbic_colname => 'me.cd' }
+ => $_ ] } ( ($cd_rs->get_column ('cdid')->all) x 2 ) ],
'next() query generated expected SQL',
);
)
me
)',
- [ map { [ 'me.cd' => $_] } ($cd_rs->get_column ('cdid')->all) ],
+ [ map { [ { sqlt_datatype => 'integer', dbic_colname => 'me.cd' }
+ => $_ ] } ($cd_rs->get_column ('cdid')->all) ],
'count() query generated expected SQL',
);
}
GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
artist.artistid, artist.name, artist.rank, artist.charfield
)',
- [ map { [ 'tracks.title' => 'ugabuganoexist' ] } (1 .. 2) ],
+ [ map { [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'tracks.title' }
+ => 'ugabuganoexist' ] } (1,2)
+ ],
);
}
WHERE ( me.rank = ? )
ORDER BY me.name ASC, me.artistid DESC, tracks.cd
)},
- [ [ 'me.rank' => 13 ], [ 'me.rank' => 13 ] ],
+ [ map { [ { sqlt_datatype => 'integer', dbic_colname => 'me.rank' }
+ => 13 ] } (1,2)
+ ],
'correct SQL on limited prefetch over search_related ordered by root',
);
cmp_ok( $rs->count, '==', 3, "count() ok after group_by on related column" );
-$rs = $schema->resultset("Artist")->search(
- {},
- { join => [qw/ cds /], group_by => [qw/ me.name /], having =>{ 'MAX(cds.cdid)'=> \'< 5' } }
-);
+$rs = $schema->resultset("Artist")->search({}, {
+ join => [qw/ cds /],
+ group_by => [qw/ me.name /],
+ having => \[ 'MAX(cds.cdid) < ?', [ \'int' => 5 ] ],
+});
cmp_ok( $rs->all, '==', 2, "results ok after group_by on related column with a having" );
}
);
-# add a floating +select to make sure it does nto throw things off
+# add a floating +select to make sure it does not throw things off
# we also expect it to appear in both selectors, as we can not know
# for sure which part of the query it applies to (may be order_by,
# maybe something else)
# we use a reference to the same array in bind vals, because
# is_deeply picks up this difference too (not sure if bug or
# feature)
-my $bind_one = [ __add => 1 ];
$use_prefetch = $use_prefetch->search({}, {
- '+select' => \[ 'me.artistid + ?', $bind_one ],
+ '+select' => \[ 'me.artistid + ?', [ \ 'inTEger' => 1 ] ],
});
+my $bind_int_resolved = sub { [ { sqlt_datatype => 'inTEger' } => 1 ] };
+my $bind_vc_resolved = sub { [
+ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'tracks.title' }
+ => 'blah-blah-1234568'
+] };
is_same_sql_bind (
$use_prefetch->as_query,
'(
ORDER BY name DESC, cds.artist, cds.year ASC
)',
[
- $bind_one, # outer select
- $bind_one, # inner select
- [ 'tracks.title' => 'blah-blah-1234568' ], # inner where
- $bind_one, # inner group_by
- [ 'tracks.title' => 'blah-blah-1234568' ], # outer where
- $bind_one, # outer group_by
+ $bind_int_resolved->(), # outer select
+ $bind_int_resolved->(), # inner select
+ $bind_vc_resolved->(), # inner where
+ $bind_int_resolved->(), # inner group_by
+ $bind_vc_resolved->(), # outer where
+ $bind_int_resolved->(), # outer group_by
],
'Expected SQL on complex limited prefetch'
);
WHERE ( ( artist.name = ? AND me.year = ? ) )
ORDER BY tracks.cd
)',
- [
- [ 'artist.name' => 'foo' ],
- [ 'me.year' => 2010 ],
- [ 'artist.name' => 'foo' ],
- [ 'me.year' => 2010 ],
- ],
+ [ map {
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'artist.name' }
+ => 'foo' ],
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.year' }
+ => 2010 ],
+ } (1,2)],
'No grouping of non-multiplying resultsets',
);
ON artist_undirected_maps.id1 = me.artistid OR artist_undirected_maps.id2 = me.artistid
WHERE ( artistid = ? )
)',
- [[artistid => 1]],
+ [[ { sqlt_datatype => 'integer', dbic_colname => 'artistid' }
+ => 1 ]],
'expected join sql produced',
);
$art_rs = $art_rs->search({ name => 'Billy Joel' });
+my $name_resolved_bind = [
+ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'name' }
+ => 'Billy Joel'
+];
+
{
is_same_sql_bind(
$art_rs->as_query,
"(SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me WHERE ( name = ? ))",
- [ [ name => 'Billy Joel' ] ],
+ [ $name_resolved_bind ],
);
}
$art_rs = $art_rs->search({ rank => 2 });
+my $rank_resolved_bind = [
+ { sqlt_datatype => 'integer', dbic_colname => 'rank' }
+ => 2
+];
+
{
is_same_sql_bind(
$art_rs->as_query,
"(SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me WHERE ( ( ( rank = ? ) AND ( name = ? ) ) ) )",
- [ [ rank => 2 ], [ name => 'Billy Joel' ] ],
+ [ $rank_resolved_bind, $name_resolved_bind ],
);
}
is_same_sql_bind(
$rscol->as_query,
"(SELECT me.charfield FROM artist me WHERE ( ( ( rank = ? ) AND ( name = ? ) ) ) )",
- [ [ rank => 2 ], [ name => 'Billy Joel' ] ],
+ [ $rank_resolved_bind, $name_resolved_bind ],
);
}
WHERE ( source = ? )
) me
)',
- [ [ source => 'Library' ] ],
+ [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ] ],
'Resultset-class attributes do not seep outside of the subselect',
);
$rs->as_query,
"(SELECT me.artistid, me.name, me.rank, me.charfield FROM (SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year FROM artist a JOIN cd ON cd.artist = a.artistid WHERE cd.year = ?) me WHERE title LIKE ?)",
[
- [ '!!dummy' => '1999' ],
- [ '!!dummy' => 'Spoon%' ]
+ [ {} => '1999' ],
+ [ {} => 'Spoon%' ]
],
'got correct SQL'
);
$rs->as_query,
"(SELECT me.artistid, me.name, me.rank, me.charfield FROM (SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year FROM artist a JOIN cd ON cd.artist = a.artistid WHERE cd.year = ?) me WHERE title LIKE ?)",
[
- [ '!!dummy' => '1999' ],
- [ '!!dummy' => 'Spoon%' ]
+ [ {} => '1999' ],
+ [ {} => 'Spoon%' ]
],
'got correct SQL (cookbook arbitrary SQL, in separate file)'
);
my $schema = DBICTest->init_schema();
my $rs = $schema->resultset('CD')->search (
- { 'tracks.id' => { '!=', 666 }},
+ { 'tracks.trackid' => { '!=', 666 }},
{ join => 'artist', prefetch => 'tracks', rows => 2 }
);
FROM cd me
JOIN artist artist ON artist.artistid = me.artist
LEFT JOIN track tracks ON tracks.cd = me.cdid
- WHERE ( tracks.id != ? )
+ WHERE ( tracks.trackid != ? )
LIMIT 2
) me
JOIN artist artist ON artist.artistid = me.artist
GROUP BY tags.tagid, tags.cd, tags.tag
)',
- [ [ 'tracks.id' => 666 ] ],
+ [ [ { sqlt_datatype => 'integer', dbic_colname => 'tracks.trackid' }
+ => 666 ]
+ ],
'Prefetch spec successfully stripped on search_related'
);
attrs => { rows => 5 },
sqlbind => \[
"( SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE (title = ? AND year LIKE ?) LIMIT 5)",
- [ title => 'buahaha' ],
- [ year => '20%' ],
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'title' }
+ => 'buahaha' ],
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'year' }
+ => '20%' ],
],
},
{
rs => $cdrs,
search => {
- artist_id => { 'in' => $art_rs->search({}, { rows => 1 })->get_column( 'id' )->as_query },
+ artistid => { 'in' => $art_rs->search({}, { rows => 1 })->get_column( 'artistid' )->as_query },
},
sqlbind => \[
- "( SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE artist_id IN ( SELECT me.id FROM artist me LIMIT 1 ) )",
+ "( SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE artistid IN ( SELECT me.artistid FROM artist me LIMIT 1 ) )",
],
},
attrs => {
alias => 'cd2',
from => [
- { cd2 => $cdrs->search({ id => { '>' => 20 } })->as_query },
+ { cd2 => $cdrs->search({ artist => { '>' => 20 } })->as_query },
],
},
sqlbind => \[
"( SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (
- SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE id > ?
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE artist > ?
) cd2
)",
- [ 'id', 20 ]
+ [ { sqlt_datatype => 'integer', dbic_colname => 'artist' } => 20 ]
],
},
alias => 'cd2',
from => [
{ cd2 => $cdrs->search(
- { id => { '>' => 20 } },
+ { artist => { '>' => 20 } },
{
alias => 'cd3',
from => [
- { cd3 => $cdrs->search( { id => { '<' => 40 } } )->as_query }
+ { cd3 => $cdrs->search( { artist => { '<' => 40 } } )->as_query }
],
}, )->as_query },
],
(SELECT cd3.cdid, cd3.artist, cd3.title, cd3.year, cd3.genreid, cd3.single_track
FROM
(SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
- FROM cd me WHERE id < ?) cd3
- WHERE id > ?) cd2
+ FROM cd me WHERE artist < ?) cd3
+ WHERE artist > ?) cd2
)",
- [ 'id', 40 ],
- [ 'id', 20 ]
+ [ { sqlt_datatype => 'integer', dbic_colname => 'artist' } => 40 ],
+ [ { dbic_colname => 'artist' } => 20 ], # no rsrc in outer manual from - hence no resolution
],
},
SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE title = ?
) cd2
)",
- [ 'title',
- 'Thriller'
+ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'title' }
+ => 'Thriller'
]
],
},
my $schema = DBICTest->init_schema();
-my $ne_bind = [ _ne => 'bar' ];
my $rs = $schema->resultset('CD')->search({ -and => [
- 'me.artist' => { '!=', 'foo' },
- 'me.artist' => { '!=', \[ '?', $ne_bind ] },
+ 'me.artist' => { '!=', '666' },
+ 'me.artist' => { '!=', \[ '?', [ _ne => 'bar' ] ] },
]});
# bogus sql query to make sure bind composition happens properly
LIMIT 1 OFFSET 2
)',
[
- [ 'me.artist' => 'foo' ],
- $ne_bind,
- [ _add => 1 ],
- [ 'me.artist' => 'foo' ],
- $ne_bind,
- [ _sub => 2 ],
- [ _lt => 3 ],
- [ _mu => 4 ],
+ [ { sqlt_datatype => 'integer', dbic_colname => 'me.artist' }
+ => 666 ],
+ [ { dbic_colname => '_ne' } => 'bar' ],
+ [ { dbic_colname => '_add' } => 1 ],
+ [ { sqlt_datatype => 'integer', dbic_colname => 'me.artist' }
+ => 666 ],
+ [ { dbic_colname => '_ne' } => 'bar' ],
+ [ { dbic_colname => '_sub' } => 2 ],
+ [ { dbic_colname => '_lt' } => 3 ],
+ [ { dbic_colname => '_mu' } => 4 ],
],
'Correct crazy sql',
);
) < 2
ORDER BY me.title
)',
- [ [ 'source', 'Library' ] ],
+ [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ] ],
);
is_deeply (
) BETWEEN 1 AND 3
ORDER BY "title" DESC
)',
- [ [ 'source', 'Library' ] ],
+ [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ] ],
);
is_deeply (
) BETWEEN 1 AND 4294967295
ORDER BY "title"
)',
- [ [ 'source', 'Library' ] ],
+ [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ] ],
);
is_deeply (
) me
WHERE rno__row__index BETWEEN 1 AND 1
)',
- [ [ 'source', 'Library' ] ],
+ [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ] ],
);
$schema->storage->_sql_maker->quote_char ([qw/ [ ] /]);
) [me]
WHERE [rno__row__index] BETWEEN 1 AND 1
)',
- [ [ 'source', 'Library' ] ],
+ [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ] ],
);
{
) me
ORDER BY me.id DESC
)',
- [ [ source => 'Library' ] ],
+ [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ] ],
);
}
) me
ORDER BY $ord_set->{order_req}
)",
- [ [ source => 'Library' ] ],
+ [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ] ],
);
}
WHERE ( source = ? )
ORDER BY title
)',
- [ [ source => 'Library' ], [ source => 'Library' ] ],
+ [ map { [
+ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ]
+ } (1,2) ],
);
# test deprecated column mixing over join boundaries
JOIN owners owner ON owner.id = me.owner
WHERE ( source = ? )
ORDER BY me.id
- )',
- [ [ 'source', 'Library' ] ],
+ )',
+ [ [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
+ => 'Library' ] ],
);
{
ORDER BY $args->{order_req}
)",
[
- [qw(foo bar)],
- [qw(read_count 5)],
- [qw(read_count 8)],
+ [ { sqlt_datatype => 'integer', dbic_colname => 'foo' }
+ => 'bar' ],
+ [ { sqlt_datatype => 'int', dbic_colname => 'read_count' }
+ => 5 ],
+ [ { sqlt_datatype => 'int', dbic_colname => 'read_count' }
+ => 8 ],
$args->{bind}
- ? @{ $args->{bind} }
+ ? map { [ { dbic_colname => $_->[0] } => $_->[1] ] } @{ $args->{bind} }
: ()
],
) || diag Dumper $args->{order_by};
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Warn;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+{
+ package DBICTest::Legacy::Storage;
+ use base 'DBIx::Class::Storage::DBI::SQLite';
+
+ use Data::Dumper::Concise;
+
+ sub source_bind_attributes { return {} }
+}
+
+
+my $schema = DBICTest::Schema->clone;
+$schema->storage_type('DBICTest::Legacy::Storage');
+$schema->connection('dbi:SQLite::memory:');
+
+$schema->storage->dbh_do( sub { $_[1]->do(<<'EOS') } );
+CREATE TABLE artist (
+ artistid INTEGER PRIMARY KEY NOT NULL,
+ name varchar(100),
+ rank integer NOT NULL DEFAULT 13,
+ charfield char(10)
+)
+EOS
+
+my $legacy = sub { $schema->resultset('Artist')->search({ name => 'foo'})->next };
+if (DBIx::Class->VERSION >= 0.09) {
+ &throws_ok(
+ $legacy,
+ qr/XXXXXXXXX not sure what error to put here yet XXXXXXXXXXXXXXX/,
+ 'deprecated use of source_bind_attributes throws',
+ );
+}
+else {
+ &warnings_exist (
+ $legacy,
+ qr/\QThe source_bind_attributes() override in DBICTest::Legacy::Storage relies on a deprecated codepath/,
+ 'Warning issued during invocation of legacy storage codepath',
+ );
+}
+
+done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff