From: Mike Francis <ungrim97@gmail.com>
Date: Fri, 18 Jul 2014 13:45:51 +0000 (+0100)
Subject: Added handling for Implicit inflate/deflate of CDBI has_a relationships
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=15d2ccd17c76c4ca18f6b32206c373be7d6b6bfd;p=dbsrgits%2FDBIx-Class-Historic.git

Added handling for Implicit inflate/deflate of CDBI has_a relationships
---

diff --git a/lib/DBIx/Class/CDBICompat/Relationships.pm b/lib/DBIx/Class/CDBICompat/Relationships.pm
index 3ce3ef5..19be13c 100644
--- a/lib/DBIx/Class/CDBICompat/Relationships.pm
+++ b/lib/DBIx/Class/CDBICompat/Relationships.pm
@@ -31,16 +31,22 @@ sub has_a {
     return 1;
 }
 
-
 sub _declare_has_a {
   my ($self, $col, $f_class, %args) = @_;
   $self->throw_exception( "No such column ${col}" )
-   unless $self->has_column($col);
+    unless $self->has_column($col);
   $self->ensure_class_loaded($f_class);
 
   my $rel_info;
 
-  if ($args{'inflate'} || $args{'deflate'}) { # Non-database has_a
+  # Class::DBI allows Non database has_a with implicit deflate and inflate
+  # Hopefully the following will catch Non-database tables.
+  if (!$f_class->isa('DBIx::Class') && !$f_class->isa('Class::DBI')){
+    $args{'inflate'} ||= sub { $f_class->new(shift); }; # implicite inflate by calling new
+    $args{'deflate'} ||= sub { my $value = shift; "$value"; }; # implicite deflate by stringification
+  }
+
+  if ($args{'inflate'} || $args{'deflate'}){ # Non-database has_a
     if (!ref $args{'inflate'}) {
       my $meth = $args{'inflate'};
       $args{'inflate'} = sub { $f_class->$meth(shift); };
@@ -52,10 +58,9 @@ sub _declare_has_a {
     $self->inflate_column($col, \%args);
 
     $rel_info = {
-        class => $f_class
+      class => $f_class
     };
-  }
-  else {
+  } else {
     $self->belongs_to($col, $f_class);
     $rel_info = $self->result_source_instance->relationship_info($col);
   }
diff --git a/t/cdbi/70_implicit_inflate.t b/t/cdbi/70_implicit_inflate.t
new file mode 100644
index 0000000..90dbbff
--- /dev/null
+++ b/t/cdbi/70_implicit_inflate.t
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+
+# Class::DBI in its infinate wisdom allows implicit inflation
+# and deflation of foriegn clas looups in has_a relationships.
+# for inflate it would call ->new on the foreign_class and for
+# deflate it would "" the column value and allow for overloading
+# of the "" operator.
+
+use Test::More;
+use DBIx::Class::Optional::Dependencies;
+
+BEGIN {
+    plan skip_all => "Test needs ".DBIx::Class::Optional::Dependencies->req_missing_for('test_dt_sqlite')
+        unless DBIx::Class::Optional::Dependencies->req_ok_for('test_dt_sqlite');
+}
+
+use DateTime;
+
+INIT {
+    use lib 't/cdbi/testlib';
+    use ImplicitInflate;
+}
+
+ok(ImplicitInflate->can('db_Main'), 'set_db()');
+is(ImplicitInflate->__driver, "SQLite", 'Driver set correctly');
+
+my $now = DateTime->now;
+
+ImplicitInflate->create({
+    update_datetime => $now,
+    text            => "Test Data",
+});
+
+my $implicit_inflate = ImplicitInflate->retrieve(text => 'Test Data');
+
+ok($implicit_inflate->update_datetime->isa('DateTime'), 'Date column inflated correctly');
+is($implicit_inflate->update_datetime => $now, 'Date has correct year');
+
+done_testing;
diff --git a/t/cdbi/testlib/ImplicitInflate.pm b/t/cdbi/testlib/ImplicitInflate.pm
new file mode 100644
index 0000000..76c2365
--- /dev/null
+++ b/t/cdbi/testlib/ImplicitInflate.pm
@@ -0,0 +1,42 @@
+package # Hide from PAUSE
+    ImplicitInflate;
+
+# Test class for the testing of Implicit inflation
+# in CDBI Classes using Compat layer
+# See t/cdbi/70-implicit_inflate.t
+
+use strict;
+use warnings;
+
+use base 'DBIC::Test::SQLite';
+
+__PACKAGE__->set_table('Date');
+
+__PACKAGE__->columns(Primary    => 'id');
+__PACKAGE__->columns(All        => qw/ update_datetime text/);
+
+__PACKAGE__->has_a(
+    update_datetime => 'MyDateStamp',
+);
+
+sub create_sql {
+       # SQLite doesn't support Datetime datatypes.
+    return qq{
+        id              INTEGER PRIMARY KEY,
+        update_datetime TEXT,
+        text            VARCHAR(20)
+    }
+}
+
+{
+    package MyDateStamp;
+
+    use DateTime::Format::SQLite;
+
+    sub new {
+        my ($self, $value) = @_;
+        return DateTime::Format::SQLite->parse_datetime($value);
+    }
+}
+
+1;