up by create() and populate()
- Ensure definitive condition extractor handles bizarre corner cases
without bombing out (RT#93244)
+ - Fix set_inflated_column incorrectly handling \[] literals (GH#44)
+ - Ensure that setting a column to a literal invariably marks it dirty
- Fix inability to handle multiple consecutive transactions with
savepoints on DBD::SQLite < 1.39
+ * Misc
+ - Stop explicitly stringifying objects before passing them to DBI,
+ instead assume that the DBI/DBD combo will take care of things
+
0.08270 2014-01-30 21:54 (PST)
* Fixes
- Fix 0.08260 regression in DBD::SQLite bound int handling. Inserted
dew: Dan Thomas <dan@godders.org>
+dim0xff: Dmitry Latin <dim0xff@gmail.com>
+
dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
dnm: Justin Wheeler <jwheeler@datademons.com>
use strict;
use warnings;
-use base qw/DBIx::Class::Row/;
+use base 'DBIx::Class::Row';
+use DBIx::Class::_Util 'is_literal_value';
+use namespace::clean;
=head1 NAME
sub _inflated_column {
my ($self, $col, $value) = @_;
return $value unless defined $value; # NULL is NULL is NULL
+
my $info = $self->column_info($col)
or $self->throw_exception("No column info for $col");
+
return $value unless exists $info->{_inflate_info};
+
my $inflate = $info->{_inflate_info}{inflate};
$self->throw_exception("No inflator for $col") unless defined $inflate;
+
return $inflate->($value, $self);
}
sub _deflated_column {
my ($self, $col, $value) = @_;
-# return $value unless ref $value && blessed($value); # If it's not an object, don't touch it
- ## Leave scalar refs (ala SQL::Abstract literal SQL), untouched, deflate all other refs
- return $value unless (ref $value && ref($value) ne 'SCALAR');
+
+ ## Deflate any refs except for literals, pass through plain values
+ return $value if (
+ ! length ref $value
+ or
+ is_literal_value($value)
+ );
+
my $info = $self->column_info($col) or
$self->throw_exception("No column info for $col");
+
return $value unless exists $info->{_inflate_info};
+
my $deflate = $info->{_inflate_info}{deflate};
$self->throw_exception("No deflator for $col") unless defined $deflate;
+
return $deflate->($value, $self);
}
if exists $self->{_inflated_column}{$col};
my $val = $self->get_column($col);
- return $val if ref $val eq 'SCALAR'; #that would be a not-yet-reloaded sclarref update
+
+ return $val if is_literal_value($val); #that would be a not-yet-reloaded literal update
return $self->{_inflated_column}{$col} = $self->_inflated_column($col, $val);
}
sub set_inflated_column {
my ($self, $col, $inflated) = @_;
$self->set_column($col, $self->_deflated_column($col, $inflated));
-# if (blessed $inflated) {
- if (ref $inflated && ref($inflated) ne 'SCALAR') {
+
+ if (length ref $inflated and ! is_literal_value($inflated) ) {
$self->{_inflated_column}{$col} = $inflated;
} else {
delete $self->{_inflated_column}{$col};
sub store_inflated_column {
my ($self, $col, $inflated) = @_;
-# unless (blessed $inflated) {
- unless (ref $inflated && ref($inflated) ne 'SCALAR') {
- delete $self->{_inflated_column}{$col};
- $self->store_column($col => $inflated);
- return $inflated;
+
+ if (is_literal_value($inflated)) {
+ delete $self->{_inflated_column}{$col};
+ $self->store_column($col => $inflated);
}
- delete $self->{_column_data}{$col};
- return $self->{_inflated_column}{$col} = $inflated;
+ else {
+ delete $self->{_column_data}{$col};
+ $self->{_inflated_column}{$col} = $inflated;
+ }
+
+ return $inflated;
}
=head1 SEE ALSO
use DBIx::Class::Carp;
use DBIx::Class::ResultSetColumn;
use Scalar::Util qw/blessed weaken reftype/;
-use DBIx::Class::_Util 'fail_on_internal_wantarray';
+use DBIx::Class::_Util qw(
+ fail_on_internal_wantarray is_plain_value is_literal_value
+);
use Try::Tiny;
use Data::Compare (); # no imports!!! guard against insane architecture
for my $c (keys %$implied) {
my $v = $implied->{$c};
- if (
- ! ref $v
- or
- overload::Method($v, '""')
- ) {
+ if ( ! length ref $v or is_plain_value($v) ) {
$new_data{$c} = $v;
}
elsif (
- ref $v eq 'HASH' and keys %$v == 1 and exists $v->{'='} and (
- ref $v->{'='} eq 'SCALAR'
- or
- ( ref $v->{'='} eq 'REF' and ref ${$v->{'='}} eq 'ARRAY' )
- )
+ ref $v eq 'HASH' and keys %$v == 1 and exists $v->{'='} and is_literal_value($v->{'='})
) {
$new_data{$c} = $v->{'='};
}
use DBIx::Class::ResultSourceHandle;
use DBIx::Class::Carp;
+use DBIx::Class::_Util 'is_literal_value';
use Devel::GlobalDestruction;
use Try::Tiny;
use List::Util 'first';
if (
ref $joinfree_cond->{$c}
and
- ref $joinfree_cond->{$c} ne 'SCALAR'
- and
- ref $joinfree_cond->{$c} ne 'REF'
+ ! is_literal_value( $joinfree_cond->{$c} )
) {
push @$cond_cols, $colname;
next;
use List::Util 'first';
use Try::Tiny;
use DBIx::Class::Carp;
+use DBIx::Class::_Util 'is_literal_value';
###
### Internal method
elsif (not defined $old) { # both undef
return 1;
}
+ elsif (
+ is_literal_value $old
+ or
+ is_literal_value $new
+ ) {
+ return 0;
+ }
elsif ($old eq $new) {
return 1;
}
return ($select, @rhs_bind);
}
- # Is the second check absolutely necessary?
elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
return @{$$fields};
}
use Sub::Name 'subname';
use Context::Preserve 'preserve_context';
use Try::Tiny;
-use overload ();
use Data::Compare (); # no imports!!! guard against insane architecture
+use DBIx::Class::_Util qw(is_plain_value is_literal_value);
use namespace::clean;
# default cursor class, overridable in connect_info attributes
and
length ref $resolved->[1]
and
- ! overload::Method($resolved->[1], '""')
+ ! is_plain_value $resolved->[1]
) {
require Data::Dumper;
local $Data::Dumper::Maxdepth = 1;
);
}
else {
- # FIXME SUBOPTIMAL - most likely this is not necessary at all
- # confirm with dbi-dev whether explicit stringification is needed
- my $v = ( length ref $bind->[$i][1] and overload::Method($bind->[$i][1], '""') )
- ? "$bind->[$i][1]"
- : $bind->[$i][1]
- ;
$sth->bind_param(
$i + 1,
- $v,
+ $bind->[$i][1],
$bind_attrs->[$i],
);
}
(
! exists $to_insert->{$col}
or
- ref $to_insert->{$col} eq 'SCALAR'
- or
- (ref $to_insert->{$col} eq 'REF' and ref ${$to_insert->{$col}} eq 'ARRAY')
+ is_literal_value($to_insert->{$col})
)
) {
$values{$col} = $self->_sequence_fetch(
}
# nothing to retrieve when explicit values are supplied
- next if (defined $to_insert->{$col} and ! (
- ref $to_insert->{$col} eq 'SCALAR'
- or
- (ref $to_insert->{$col} eq 'REF' and ref ${$to_insert->{$col}} eq 'ARRAY')
- ));
+ next if (
+ defined $to_insert->{$col} and ! is_literal_value($to_insert->{$col})
+ );
# the 'scalar keys' is a trick to preserve the ->columns declaration order
$retrieve_cols{$col} = scalar keys %retrieve_cols if (
my @col_range = (0..$#$cols);
- # FIXME SUBOPTIMAL - most likely this is not necessary at all
- # confirm with dbi-dev whether explicit stringification is needed
- #
- # forcibly stringify whatever is stringifiable
- # ResultSet::populate() hands us a copy - safe to mangle
- for my $r (0 .. $#$data) {
- for my $c (0 .. $#{$data->[$r]}) {
- $data->[$r][$c] = "$data->[$r][$c]"
- if ( length ref $data->[$r][$c] and overload::Method($data->[$r][$c], '""') );
- }
- }
-
my $colinfos = $source->columns_info($cols);
local $self->{_autoinc_supplied_for_op} =
}
}
elsif (! defined $value_type_by_col_idx->{$col_idx} ) { # regular non-literal value
- if (ref $val eq 'SCALAR' or (ref $val eq 'REF' and ref $$val eq 'ARRAY') ) {
+ if (is_literal_value($val)) {
$bad_slice_report_cref->("Literal SQL found where a plain bind value is expected", $row_idx, $col_idx);
}
}
use base qw/DBIx::Class::Storage::DBI/;
use mro 'c3';
-use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer);
+use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer is_plain_value);
use DBIx::Class::Carp;
use Try::Tiny;
use namespace::clean;
for my $i (0.. $#$bindattrs) {
- $stringifiable++ if ( length ref $bind->[$i][1] and overload::Method($bind->[$i][1], '""') );
+ $stringifiable++ if ( length ref $bind->[$i][1] and is_plain_value($bind->[$i][1]) );
if (
defined $bindattrs->[$i]
use List::Util 'first';
use Scalar::Util 'blessed';
use Sub::Name 'subname';
+use DBIx::Class::_Util qw(is_plain_value is_literal_value);
use namespace::clean;
#
my ($l, $r) = %$p;
- push @conds, ( ! ref $r or overload::Method($r, '""' ) )
+ push @conds, ( ! length ref $r or is_plain_value($r) )
? { $l => $r }
: { $l => { '=' => $r } }
;
for my $c (keys %$where_hash) {
if (defined (my $v = $where_hash->{$c}) ) {
if (
- ! ref $v
+ ! length ref $v
or
(ref $v eq 'HASH' and keys %$v == 1 and defined $v->{'='} and (
- ! ref $v->{'='}
- or
- ref $v->{'='} eq 'SCALAR'
- or
- ( ref $v->{'='} eq 'REF' and ref ${$v->{'='}} eq 'ARRAY' )
- or
- overload::Method($v->{'='}, '""')
+ is_literal_value($v->{'='}) or is_plain_value( $v->{'='})
))
) {
$res->{$c} = 1;
use Carp 'croak';
use Scalar::Util qw(weaken blessed reftype);
+use List::Util qw(first);
+use overload ();
use base 'Exporter';
-our @EXPORT_OK = qw(sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray refcount hrefaddr is_exception);
+our @EXPORT_OK = qw(
+ sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray
+ refcount hrefaddr is_exception
+ is_plain_value is_literal_value
+);
sub sigwarn_silencer ($) {
my $pattern = shift;
eval { $mod->VERSION($ver) } ? 1 : 0;
}
+sub is_literal_value ($) {
+ (
+ ref $_[0] eq 'SCALAR'
+ or
+ ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' )
+ ) ? 1 : 0;
+}
+
+# FIXME XSify - this can be done so much more efficiently
+sub is_plain_value ($) {
+ no strict 'refs';
+ (
+ # plain scalar
+ (! length ref $_[0])
+ or
+ (
+ blessed $_[0]
+ and
+ # deliberately not using Devel::OverloadInfo - the checks we are
+ # intersted in are much more limited than the fullblown thing, and
+ # this is a relatively hot piece of code
+ (
+ # either has stringification which DBI prefers out of the box
+ #first { *{$_ . '::(""'}{CODE} } @{ mro::get_linear_isa( ref $_[0] ) }
+ overload::Method($_[0], '""')
+ or
+ # has nummification and fallback is *not* disabled
+ (
+ $_[1] = first { *{"${_}::(0+"}{CODE} } @{ mro::get_linear_isa( ref $_[0] ) }
+ and
+ ( ! defined ${"$_[1]::()"} or ${"$_[1]::()"} )
+ )
+ )
+ )
+ ) ? 1 : 0;
+}
+
{
my $list_ctx_ok_stack_marker;
)
? ()
# one unique for populate() and create() each
- : (qr/\QPOSSIBLE *PAST* DATA CORRUPTION detected \E.+\QTrigger condition encountered at @{[ __FILE__ ]} line\E \d/) x 2
+ : (qr/\QPOSSIBLE *PAST* DATA CORRUPTION detected \E.+\QTrigger condition encountered at @{[ __FILE__ ]} line\E \d/) x 3
], 'Data integrity warnings as planned';
lives_ok {
my $skip_inflation = $event->skip_inflation;
is ("$skip_inflation", '2006-04-21 18:04:06', 'Correct date/time');
+# create and update with literals
+{
+ my $d = {
+ created_on => \ '2001-09-11',
+ starts_at => \[ '?' => '2001-10-26' ],
+ };
+
+ my $ev = $schema->resultset('Event')->create($d);
+
+ for my $col (qw(created_on starts_at)) {
+ ok (ref $ev->$col, "literal untouched in $col");
+ is_deeply( $ev->$col, $d->{$col});
+ is_deeply( $ev->get_inflated_column($col), $d->{$col});
+ is_deeply( $ev->get_column($col), $d->{$col});
+ }
+
+ $ev->discard_changes;
+
+ is_deeply(
+ { $ev->get_dirty_columns },
+ {}
+ );
+
+ for my $col (qw(created_on starts_at)) {
+ isa_ok ($ev->$col, "DateTime", "$col properly inflated on retrieve");
+ }
+
+ for my $meth (qw(set_inflated_columns set_columns)) {
+
+ $ev->$meth({%$d});
+
+ is_deeply(
+ { $ev->get_dirty_columns },
+ $d,
+ "Expected dirty cols after setting literals via $meth",
+ );
+
+ $ev->update;
+
+ for my $col (qw(created_on starts_at)) {
+ ok (ref $ev->$col, "literal untouched in $col updated via $meth");
+ is_deeply( $ev->$col, $d->{$col});
+ is_deeply( $ev->get_inflated_column($col), $d->{$col});
+ is_deeply( $ev->get_column($col), $d->{$col});
+ }
+ }
+}
+
done_testing;
--- /dev/null
+use warnings;
+use strict;
+
+use Test::More;
+use Test::Warn;
+
+use lib qw(t/lib);
+use DBICTest;
+
+use DBIx::Class::_Util 'is_plain_value';
+
+{
+ package # hideee
+ DBICTest::SillyInt;
+
+ use overload
+ # *DELIBERATELY* unspecified
+ #fallback => 1,
+ '0+' => sub { ${$_[0]} },
+ ;
+
+
+ package # hideee
+ DBICTest::SillyInt::Subclass;
+
+ our @ISA = 'DBICTest::SillyInt';
+
+
+ package # hideee
+ DBICTest::CrazyInt;
+
+ use overload
+ '0+' => sub { 666 },
+ '""' => sub { 999 },
+ fallback => 1,
+ ;
+}
+
+# check DBI behavior when fed a stringifiable/nummifiable value
+{
+ my $crazynum = bless {}, 'DBICTest::CrazyInt';
+ cmp_ok( $crazynum, '==', 666 );
+ cmp_ok( $crazynum, 'eq', 999 );
+
+ my $schema = DBICTest->init_schema( no_populate => 1 );
+ $schema->storage->dbh_do(sub {
+ $_[1]->do('INSERT INTO artist (name) VALUES (?)', {}, $crazynum );
+ });
+
+ is( $schema->resultset('Artist')->next->name, 999, 'DBI preferred stringified version' );
+}
+
+# make sure we recognize overloaded stuff properly
+{
+ my $num = bless( \do { my $foo = 69 }, 'DBICTest::SillyInt::Subclass' );
+ ok( is_plain_value $num, 'parent-fallback-provided stringification detected' );
+ is("$num", 69, 'test overloaded object stringifies, without specified fallback');
+}
+
+done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff