[Dbix-class] Should all result classes set C3 MRO?

[Andrew Gregory]

Following the example in the cookbook[1], I moved components into
a base result class, only to discover that cascaded deletion no longer
worked.  Apparently, load_components sets the MRO to C3, which
DBIx::Class relies on heavily.  Moving those calls out of the
individual result classes caused them to revert to perl's default DFS
MRO.  Since InflateColumn is a subclass of DBIx::Class::Row, Row's
delete method appears before CascadeActions wrapper under DFS.  An
example script is below.

Is there any way to set the MRO for all loaded classes so that a base
class, or even DBIx::Class itself, could handle this transparently, or
do all classes need to individually ensure that they use C3?

[1]: 
https://metacpan.org/pod/distribution/DBIx-Class/lib/DBIx/Class/Manual/Cookbook.pod#Move-Common-Startup-into-a-Base-Class

## broken cascade example
package Test::Schema::Result;
use base 'DBIx::Class::Core';

## loads DBIx::Class::Row, putting it above
## DBIx::Class::Relationship::CascadeActions for default DFS MRO
__PACKAGE__->load_components('InflateColumn::DateTime');

package Test::Schema::Result::Bar;
use base 'Test::Schema::Result';

## uncommenting either of these set C3 MRO, putting CascadeActions before Row
#use mro 'c3';
#__PACKAGE__->load_components('InflateColumn::DateTime');

__PACKAGE__->table('Bar');
__PACKAGE__->add_columns( id => { data_type => 'integer', is_numeric => 1 } );
__PACKAGE__->set_primary_key('id');
__PACKAGE__->has_many( foo => 'Test::Schema::Result::Foo' => 'bar_id' );

package Test::Schema::Result::Foo;
use base 'Test::Schema::Result';

__PACKAGE__->table('foo');
__PACKAGE__->add_columns(
id => { data_type => 'integer', is_numeric => 1 },
bar_id => { data_type => 'integer', is_numeric => 1 },
);
__PACKAGE__->set_primary_key('id');
__PACKAGE__->belongs_to( bar => 'Test::Schema::Result::Bar' => 'id' );

package Test::Schema;
use base 'DBIx::Class::Schema';

__PACKAGE__->register_class( Bar => 'Test::Schema::Result::Bar' );
__PACKAGE__->register_class( Foo => 'Test::Schema::Result::Foo' );

package main;

use Test::More;

my $schema = Test::Schema->connect('dbi:SQLite:dbname=:memory:');
$schema->deploy;

my ( $bar_rs, $foo_rs )
  = ( $schema->resultset('Bar'), $schema->resultset('Foo') );

$bar_rs->create( { id => 1 } );
$foo_rs->create( { id => 1, bar_id => 1 } );

is( $bar_rs->count, 1 );
is( $foo_rs->count, 1 );

$bar_rs->find(1)->delete; # should cascade to delete foo as well

is( $bar_rs->count, 0 );
is( $foo_rs->count, 0 );

___
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@lists.scsys.co.uk

[Dbix-class] Status of DBIx::Class

[Andrew Gregory]

What is the current status of DBIx::Class?  It looks like development
has all but stopped since last October.[1]  Is somebody actively
maintaining DBIx::Class somewhere else?  I sent an email to this list
two months ago regarding a bug that causes incorrect data to be
inserted with no response from this list.[2]  Is there a better way
for me to work toward getting the bug fixed?

[1]: https://github.com/dbsrgits/dbix-class/graphs/commit-activity
[2]: http://lists.scsys.co.uk/pipermail/dbix-class/2017-May/012630.html

apg

___
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@lists.scsys.co.uk

[Dbix-class] fast-path populate inserts incorrect data

[Andrew Gregory]

_dbh_execute_for_fetch handles some columns (e.g. MONEY columns with
MS SQL Server) incorrectly.  For columns that are casted during
insertion, the column data is not in the format _dbh_execute_for_fetch
expects.  It tries to extract the _bind_data_slice_idx field, but it
is located inside a second list element like so:

 [
   {
 'dbic_colname' => 'money_col',
 'sqlt_datatype' => 'MONEY'
   },
   \[
 '?',
 [
   {
 '_bind_data_slice_idx' => 0,
 'dbic_colname' => 'money_col'
   },
   '0.50'
 ]
   ]
 ],

Instead of the appropriate index, it gets undef, which it then uses as
an index into the row values, causing it to incorrectly insert the
first value in the row for all of these columns.

The following patch appears to fix the issue, but I'm not nearly
familiar enough with the codebase to know if it's the correct
solution:

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 9600389b..40d71eeb 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -2317,7 +2317,7 @@ sub _dbh_execute_for_fetch {
 ? "$v"
 : $v
   ;
-} map { $_->[0] } @$proto_bind ];
+} map { ref $_->[1] ? ${$_->[1]}->[1][0] : $_->[0] } @$proto_bind ];
   };
 
   my $tuple_status = [];

Finally, here is a test case to replicate the issue:

#!/usr/bin/perl

use strict;
use warnings;

package FPP::Schema::Result::Table;
use parent 'DBIx::Class::Core';

__PACKAGE__->table('dummy');
__PACKAGE__->add_columns(
rowid  => { data_type => 'INT',   is_numeric => 1 },
amount => { data_type => 'MONEY', is_numeric => 1 },
);
__PACKAGE__->set_primary_key('rowid');

package FPP::Schema;
use parent 'DBIx::Class::Schema';

# force MSSQL syntax which uses a CAST when inserting MONEY values
__PACKAGE__->storage_type('::DBI::MSSQL');
__PACKAGE__->register_source( 'Table',
FPP::Schema::Result::Table->result_source_instance );

package main;

# SQLite's syntax is flexible enough to accommodate SQL Server statements
my $schema = FPP::Schema->connect('dbi:SQLite:dbname=:memory:');
$schema->deploy();

$schema->storage->debug(1);

# fast-path populate; note the warning about an uninitialized value
$schema->resultset('Table')->populate( [ [qw( rowid amount )], [ 1, 250 ] ] );

# slow-path populate
scalar $schema->resultset('Table')
  ->populate( [ [qw( rowid amount )], [ 2, 150 ] ] );

# table should look like:
#  rowid amount
#  1250
#  2150
#
# instead, we get:
#  rowid amount
#  1  1
#  2150

foreach my $row ( $schema->resultset('Table')->all ) {
print 'rowid: ',  $row->rowid,  "\n";
print 'amount: ', $row->amount, "\n";
}

___
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@lists.scsys.co.uk