From de08b734c006749d8a5e212a16bc885b8865e076 Mon Sep 17 00:00:00 2001
From: Norbert Buchmuller <norbi@nix.hu>
Date: Wed, 30 Mar 2011 00:48:40 +0200
Subject: [PATCH] Made it work in roles (under Moose 2.x).

Now attributes with 'add_column' option can be defined in roles and then
the role can be applied to DBIC result classes (but strictly after a
->table() call..).
---
 .../Class/MooseColumns/Meta/Role/Attribute.pm | 52 +++++++++++--------
 t/30-attr_defined_in_role.t                   | 49 +++++++++++++++++
 t/lib/TestSchema/Result/CD.pm                 | 16 ++++++
 t/lib/TestSchema/Role/HasTitle.pm             | 17 ++++++
 4 files changed, 112 insertions(+), 22 deletions(-)
 create mode 100644 t/30-attr_defined_in_role.t
 create mode 100644 t/lib/TestSchema/Result/CD.pm
 create mode 100644 t/lib/TestSchema/Role/HasTitle.pm

diff --git a/lib/DBIx/Class/MooseColumns/Meta/Role/Attribute.pm b/lib/DBIx/Class/MooseColumns/Meta/Role/Attribute.pm
index 1ddf681..822c2a4 100644
--- a/lib/DBIx/Class/MooseColumns/Meta/Role/Attribute.pm
+++ b/lib/DBIx/Class/MooseColumns/Meta/Role/Attribute.pm
@@ -11,40 +11,48 @@ DBIx::Class::MooseColumns::Meta::Role::Attribute - Attribute metaclass trait for
 
 =cut
 
+has _column_info => (
+  isa => 'Maybe[HashRef]',
+  is  => 'rw',
+);
+
 around new => sub {
   my ($orig, $class, $name, %options) = @_;
 
   my $column_info = delete $options{add_column};
   $column_info->{accessor} = $options{accessor} if $options{accessor};
 
-  my $is_inflated_column;
+  my $self = $class->$orig($name, %options);
 
-  if ($column_info) {
-    my $target_pkg = $options{definition_context}->{package};
-    
-    $target_pkg->add_column($name => $column_info);
+  $self->_column_info($column_info);
 
-    # removing the accessor method that CAG installed (otherwise Moose
-    # complains)
-    $target_pkg->meta->remove_method($column_info->{accessor} || $name);
+  return $self;
+};
 
-    #FIXME respect the API - check for $target_pkg->inflate_column() calls instead of peeking into the guts of the object
-    if (exists $target_pkg->column_info($name)->{_inflate_info}) {
-      $is_inflated_column = 1;
-    }
-  }
+before attach_to_class => sub {
+  my ($self, $meta) = @_;
 
-  my $self = $class->$orig($name, %options);
+  my $column_info = $self->_column_info
+    or return;
 
-  if ($column_info) {
-    ensure_all_roles($self,
-      $is_inflated_column
-        ? 'DBIx::Class::MooseColumns::Meta::Role::Attribute::DBICColumn::Inflated'
-        : 'DBIx::Class::MooseColumns::Meta::Role::Attribute::DBICColumn'
-    );
-  }
+  my $class     = $meta->name;
+  my $attr_name = $self->name;
 
-  return $self;
+  $class->add_column($attr_name => $column_info);
+
+  # removing the accessor method that CAG installed (otherwise Moose
+  # complains)
+  $meta->remove_method($column_info->{accessor} || $attr_name);
+
+  #FIXME respect the API - check for $class->inflate_column() calls instead of peeking into the guts of the object
+  my $is_inflated_column
+    = exists $class->column_info($self->name)->{_inflate_info};
+
+  ensure_all_roles($self,
+    $is_inflated_column
+      ? 'DBIx::Class::MooseColumns::Meta::Role::Attribute::DBICColumn::Inflated'
+      : 'DBIx::Class::MooseColumns::Meta::Role::Attribute::DBICColumn'
+  );
 };
 
 1;
diff --git a/t/30-attr_defined_in_role.t b/t/30-attr_defined_in_role.t
new file mode 100644
index 0000000..959fda8
--- /dev/null
+++ b/t/30-attr_defined_in_role.t
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::Most;
+
+use FindBin;
+use Path::Class;
+use lib dir($FindBin::Bin)->subdir('lib')->stringify;
+
+use Moose::Util qw(apply_all_roles);
+
+# must be a BEGIN b/c the first test is in a BEGIN, too :-(
+BEGIN {
+  require Moose;
+  plan skip_all => 'Using DBIx::Class::MooseColumns in roles is not supported under Moose 1.x'
+    if $Moose::VERSION < 1.99;
+}
+
+# test for the role being applied smoothly
+
+BEGIN {
+  require TestSchema::Result::CD;
+  lives_and {
+    warnings_are {
+      apply_all_roles('TestSchema::Result::CD', 'TestSchema::Role::HasTitle');
+    } [];
+  } "applying the role to a result class does not throw nor warn";
+}
+
+use Test::DBIx::Class;
+
+fixtures_ok 'basic', 'installed the basic fixtures from configuration files';
+
+# tests for ->add_column() being called for an attribute defined in a role
+
+{
+  lives_and {
+    cmp_deeply(
+      Schema->resultset('CD')->result_source->column_info('title'),
+      superhashof({
+        is_nullable => 1,
+      })
+    );
+  } "column_info of 'title' contains ('is_nullable' => 1)";
+}
+
+done_testing;
diff --git a/t/lib/TestSchema/Result/CD.pm b/t/lib/TestSchema/Result/CD.pm
new file mode 100644
index 0000000..7889793
--- /dev/null
+++ b/t/lib/TestSchema/Result/CD.pm
@@ -0,0 +1,16 @@
+package TestSchema::Result::CD;
+
+use Moose;
+use MooseX::NonMoose;
+use namespace::autoclean;
+
+extends 'DBIx::Class::Core';
+
+__PACKAGE__->table('cd');
+
+__PACKAGE__->add_column('cd_id');
+
+# this class is intentionally left immutable (so that we can apply the role
+# later)
+
+1;
diff --git a/t/lib/TestSchema/Role/HasTitle.pm b/t/lib/TestSchema/Role/HasTitle.pm
new file mode 100644
index 0000000..ac4231e
--- /dev/null
+++ b/t/lib/TestSchema/Role/HasTitle.pm
@@ -0,0 +1,17 @@
+package TestSchema::Role::HasTitle;
+
+use Moose::Role;
+use namespace::autoclean;
+
+use DBIx::Class::MooseColumns;
+
+# used for testing if the attribute works on the class this role was applied to
+has title => (
+  isa => 'Maybe[Str]',
+  is  => 'rw',
+  add_column => {
+    is_nullable => 1,
+  },
+);
+
+1;