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-Tag: v0.082800~111
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=7ad8022223af1f054ba826716e7099c6d16d5699

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

diff --git a/Changes b/Changes
index e1876f3..a4f3870 100644
--- a/Changes
+++ b/Changes
@@ -12,6 +12,8 @@ Revision history for DBIx::Class
           (i.e. $result->set_from_related($custom_rel, $foreign_result_object)
         - When in a transaction, DBIC::Ordered now seamlesly handles result
           objects that went out of sync with the storage (RT#96499)
+        - CDBICompat::columns() now supports adding columns through supplied
+          Class::DBI::Column instances (GH#52)
 
     * Fixes
         - Fix Resultset delete/update affecting *THE ENTIRE TABLE* in cases
diff --git a/lib/DBIx/Class/CDBICompat/AccessorMapping.pm b/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
index 1ea49e8..1555937 100644
--- a/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
+++ b/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
@@ -4,14 +4,21 @@ package # hide from PAUSE Indexer
 use strict;
 use warnings;
 
+use Scalar::Util 'blessed';
+use namespace::clean;
+
 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 (defined blessed $col and $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..cc998c3
--- /dev/null
+++ b/t/cdbi/71_column_object.t
@@ -0,0 +1,29 @@
+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;
+
+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;
+$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..11eeb89
--- /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;