);
}
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,
- (ref $bind->[$i][1] and overload::Method($bind->[$i][1], '""'))
- ? "$bind->[$i][1]"
- : $bind->[$i][1]
- ,
+ $v,
$bind_attrs->[$i],
);
}
my @col_range = (0..$#$cols);
- # FIXME - perhaps this is not even needed? does DBI stringify?
+ # 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 ( ref $data->[$r][$c] and overload::Method($data->[$r][$c], '""') );
+ if ( length ref $data->[$r][$c] and overload::Method($data->[$r][$c], '""') );
}
}
This class implements autoincrements for SQLite.
+=head2 Known Issues
+
+=over
+
+=item RT79576
+
+ NOTE - This section applies to you only if ALL of these are true:
+
+ * You are or were using DBD::SQLite with a version lesser than 1.38_01
+
+ * You are or were using DBIx::Class versions between 0.08191 and 0.08209
+ (inclusive) or between 0.08240-TRIAL and 0.08242-TRIAL (also inclusive)
+
+ * You use objects with overloaded stringification and are feeding them
+ to DBIC CRUD methods directly
+
+An unfortunate chain of events led to DBIx::Class silently hitting the problem
+described in L<RT#79576|https://rt.cpan.org/Public/Bug/Display.html?id=79576>.
+
+In order to trigger the bug condition one needs to supply B<more than one>
+bind value that is an object with overloaded stringification (nummification
+is not relevant, only stringification is). When this is the case the internal
+DBIx::Class call to C<< $sth->bind_param >> would be executed in a way that
+triggers the above-mentioned DBD::SQLite bug. As a result all the logs and
+tracers will contain the expected values, however SQLite will receive B<all>
+these bind positions being set to the value of the B<last> supplied
+stringifiable object.
+
+Even if you upgrade DBIx::Class (which works around the bug starting from
+version 0.08210) you may still have corrupted/incorrect data in your database.
+DBIx::Class will currently detect when this condition (more than one
+stringifiable object in one CRUD call) is encountered and will issue a warning
+pointing to this section. This warning will be removed 2 years from now,
+around April 2015, You can disable it after you've audited your data by
+setting the C<DBIC_RT79576_NOWARN> environment variable. Note - the warning
+is emited only once per callsite per process and only when the condition in
+question is encountered. Thus it is very unlikey that your logsystem will be
+flooded as a result of this.
+
+=back
+
=head1 METHODS
=cut
# version is detected
sub _dbi_attrs_for_bind {
my ($self, $ident, $bind) = @_;
+
my $bindattrs = $self->next::method($ident, $bind);
+ # an attempt to detect former effects of RT#79576, bug itself present between
+ # 0.08191 and 0.08209 inclusive (fixed in 0.08210 and higher)
+ my $stringifiable = 0;
+
for (0.. $#$bindattrs) {
+
+ $stringifiable++ if ( length ref $bind->[$_][1] and overload::Method($bind->[$_][1], '""') );
+
if (
defined $bindattrs->[$_]
and
}
}
+ carp_unique(
+ 'POSSIBLE *PAST* DATA CORRUPTION detected - see '
+ . 'DBIx::Class::Storage::DBI::SQLite/RT79576 or '
+ . 'http://v.gd/DBIC_SQLite_RT79576 for further details or set '
+ . '$ENV{DBIC_RT79576_NOWARN} to disable this warning. Trigger '
+ . 'condition encountered'
+ ) if (!$ENV{DBIC_RT79576_NOWARN} and $stringifiable > 1);
+
return $bindattrs;
}
use Test::More;
use Test::Exception;
+use Test::Warn;
use lib qw(t/lib);
use DBICTest;
use Path::Class::File ();
+use Math::BigInt;
use List::Util qw/shuffle/;
+use Storable qw/nfreeze dclone/;
my $schema = DBICTest->init_schema();
]);
} 'literal+bind with semantically identical attrs works after normalization';
-# the stringification has nothing to do with the artist name
-# this is solely for testing consistency
-my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
-my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
-
-lives_ok {
- $rs->populate([
- {
- name => 'supplied before stringifying object',
- },
- {
- name => $fn,
- }
- ]);
-} 'stringifying objects pass through';
-
-# ... and vice-versa.
-
-lives_ok {
- $rs->populate([
- {
- name => $fn2,
- },
- {
- name => 'supplied after stringifying object',
- },
- ]);
-} 'stringifying objects pass through';
-
-for (
- $fn,
- $fn2,
- 'supplied after stringifying object',
- 'supplied before stringifying object'
-) {
- my $row = $rs->find ({name => $_});
- ok ($row, "Stringification test row '$_' properly inserted");
-}
-
-$rs->delete;
-
-# test stringification with ->create rather than Storage::insert_bulk as well
+# test all kinds of population with stringified objects
+warnings_like {
+ my $rs = $schema->resultset('Artist')->search({}, { columns => [qw(name rank)], order_by => 'artistid' });
+
+ # the stringification has nothing to do with the artist name
+ # this is solely for testing consistency
+ my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
+ my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
+ my $rank = Math::BigInt->new(42);
+
+ my $args = {
+ 'stringifying objects after regular values' => [ map
+ { { name => $_, rank => $rank } }
+ (
+ 'supplied before stringifying objects',
+ 'supplied before stringifying objects 2',
+ $fn,
+ $fn2,
+ )
+ ],
+ 'stringifying objects before regular values' => [ map
+ { { name => $_, rank => $rank } }
+ (
+ $fn,
+ $fn2,
+ 'supplied after stringifying objects',
+ 'supplied after stringifying objects 2',
+ )
+ ],
+ 'stringifying objects between regular values' => [ map
+ { { name => $_, rank => $rank } }
+ (
+ 'supplied before stringifying objects',
+ $fn,
+ $fn2,
+ 'supplied after stringifying objects',
+ )
+ ],
+ 'stringifying objects around regular values' => [ map
+ { { name => $_, rank => $rank } }
+ (
+ $fn,
+ 'supplied between stringifying objects',
+ $fn2,
+ )
+ ],
+ };
+
+ local $Storable::canonical = 1;
+ my $preimage = nfreeze([$fn, $fn2, $rank, $args]);
+
+ for my $tst (keys %$args) {
+
+ # test void ctx
+ $rs->delete;
+ $rs->populate($args->{$tst});
+ is_deeply(
+ $rs->all_hri,
+ $args->{$tst},
+ "Populate() $tst in void context"
+ );
+
+ # test non-void ctx
+ $rs->delete;
+ my $dummy = $rs->populate($args->{$tst});
+ is_deeply(
+ $rs->all_hri,
+ $args->{$tst},
+ "Populate() $tst in non-void context"
+ );
+
+ # test create() as we have everything set up already
+ $rs->delete;
+ $rs->create($_) for @{$args->{$tst}};
+
+ is_deeply(
+ $rs->all_hri,
+ $args->{$tst},
+ "Create() $tst"
+ );
+ }
-lives_ok {
- my @dummy = $rs->populate([
- {
- name => 'supplied before stringifying object',
- },
- {
- name => $fn,
- }
- ]);
-} 'stringifying objects pass through';
+ ok (
+ ($preimage eq nfreeze( [$fn, $fn2, $rank, $args] )),
+ 'Arguments fed to populate()/create() unchanged'
+ );
-# ... and vice-versa.
-
-lives_ok {
- my @dummy = $rs->populate([
- {
- name => $fn2,
- },
- {
- name => 'supplied after stringifying object',
- },
- ]);
-} 'stringifying objects pass through';
-
-for (
- $fn,
- $fn2,
- 'supplied after stringifying object',
- 'supplied before stringifying object'
-) {
- my $row = $rs->find ({name => $_});
- ok ($row, "Stringification test row '$_' properly inserted");
-}
+ $rs->delete;
+} [
+ # warning to be removed around Apr 1st 2015
+ # smokers start failing a month before that
+ (
+ ( DBICTest::RunMode->is_author and ( time() > 1427846400 ) )
+ or
+ ( DBICTest::RunMode->is_smoker and ( time() > 1425168000 ) )
+ )
+ ? ()
+ # one unique for populate() and create() each
+ : (qr/\QPOSSIBLE *PAST* DATA CORRUPTION detected \E.+\QTrigger condition encountered at @{[ __FILE__ ]} line\E \d/) x 2
+], 'Data integrity warnings as planned';
lives_ok {
$schema->resultset('TwoKeys')->populate([{
projects / dbsrgits/DBIx-Class.git / commitdiff