From: Mike Francis <ungrim97@gmail.com>
Date: Mon, 21 Jul 2014 15:13:46 +0000 (+0100)
Subject: Added support for handling Class::DBI::Column in CDBICompat
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Fghpr%2Fapplied%2Fas_7ad80222;p=dbsrgits%2FDBIx-Class-Historic.git

Added support for handling Class::DBI::Column in CDBICompat
---

diff --git a/lib/DBIx/Class/CDBICompat/AccessorMapping.pm b/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
index 1ea49e8..65832a3 100644
--- a/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
+++ b/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
@@ -8,10 +8,14 @@ sub mk_group_accessors {
     my ($class, $group, @cols) = @_;
 
     foreach my $col (@cols) {
-        my($accessor, $col) = ref $col ? @$col : (undef, $col);
+        my($accessor, $col) = ref $col eq 'ARRAY' ? @$col : (undef, $col);
 
         my($ro_meth, $wo_meth);
-        if( defined $accessor and ($accessor ne $col)) {
+        if (ref $col && $col->isa('Class::DBI::Column')){
+            $ro_meth = $col->accessor;
+            $wo_meth = $col->mutator;
+        }
+        elsif (defined $accessor and ($accessor ne $col)) {
             $ro_meth = $wo_meth = $accessor;
         }
         else {
diff --git a/t/cdbi/71_column_object.t b/t/cdbi/71_column_object.t
new file mode 100644
index 0000000..70ac8e3
--- /dev/null
+++ b/t/cdbi/71_column_object.t
@@ -0,0 +1,31 @@
+use strict;
+use warnings;
+
+# Columns in CDBI could be defined as Class::DBI::Column objects rather than
+# or as well as with __PACKAGE__->columns();
+
+use Test::More;
+
+INIT {
+    use lib 't/cdbi/testlib';
+    use ColumnObject;
+}
+
+ok(ColumnObject->can('db_Main'), 'set_db()');
+is(ColumnObject->__driver, 'SQLite', 'Driver set correctly');
+
+ColumnObject->create({
+    columna          => 'Test Data',
+    columnb          => 'Test Data 2',
+});
+
+my $column_object = ColumnObject->retrieve(columna => 'Test Data');
+$column_object->columnb_as_write('Test Data Written');
+$column_object->update;
+my $column_object = ColumnObject->retrieve(columna => 'Test Data');
+
+is($column_object->columna_as_read   => 'Test Data', 'Read column via accessor');
+is($column_object->columna           => 'Test Data', 'Real column returns right data');
+is($column_object->columnb           => 'Test Data Written', 'ColumnB wrote via mutator');
+
+done_testing;
diff --git a/t/cdbi/testlib/ColumnObject.pm b/t/cdbi/testlib/ColumnObject.pm
new file mode 100644
index 0000000..6e0d9d2
--- /dev/null
+++ b/t/cdbi/testlib/ColumnObject.pm
@@ -0,0 +1,29 @@
+package # Hide from PAUSE
+    ColumnObject;
+
+use strict;
+use warnings;
+
+use base 'DBIC::Test::SQLite';
+use Class::DBI::Column;
+
+__PACKAGE__->set_table('column_object');
+
+__PACKAGE__->columns( Primary => 'id' );
+__PACKAGE__->columns( All => (
+    'id',
+    'columna',
+    'columnb',
+    Class::DBI::Column->new('columna' => {accessor => 'columna_as_read'}),
+    Class::DBI::Column->new('columnb' => {mutator  => 'columnb_as_write'}),
+));
+
+sub create_sql {
+    return qq{
+        id       INTEGER PRIMARY KEY,
+        columna  VARCHAR(20),
+        columnb  VARCHAR(20)
+    }
+}
+
+1;