From: Rafael Kitover <rkitover@cpan.org>
Date: Tue, 6 Jul 2010 10:57:34 +0000 (-0400)
Subject: make use_moose work with additional_base_classes and left_base_classes options
X-Git-Tag: 0.07001~17
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6c2b21a548e7c03424fdd40eab124b44a08077fc;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

make use_moose work with additional_base_classes and left_base_classes options
---

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 46357c2..3ebab77 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -545,10 +545,9 @@ sub new {
 
     if ($self->use_moose) {
         eval <<'EOF';
-package __DBICSL__DUMMY;
-use Moose;
-use MooseX::NonMoose;
-use namespace::autoclean;
+require Moose;
+require MooseX::NonMoose;
+require namespace::autoclean;
 EOF
         if ($@) {
             die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n",
@@ -1108,7 +1107,7 @@ sub _reload_classes {
             local *Class::C3::reinitialize = sub {};
             use warnings;
 
-            if ($class->can('meta')) {
+            if ($class->can('meta') && (ref $class->meta)->isa('Moose::Meta::Class')) {
                 $class->meta->make_mutable;
             }
             Class::Unload->unload($class) if $unload;
@@ -1119,7 +1118,7 @@ sub _reload_classes {
                 && ($resultset_class ne 'DBIx::Class::ResultSet')
             ) {
                 my $has_file = Class::Inspector->loaded_filename($resultset_class);
-                if ($resultset_class->can('meta')) {
+                if ($resultset_class->can('meta') && (ref $resultset_class->meta)->isa('Moose::Meta::Class')) {
                     $resultset_class->meta->make_mutable;
                 }
                 Class::Unload->unload($resultset_class) if $unload;
@@ -1234,7 +1233,15 @@ sub _dump_to_dir {
             . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
             . qq|use strict;\nuse warnings;\n\n|;
         if ($self->use_moose) {
-            $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends '$result_base_class';\n\n|;
+            $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;|;
+
+            # these options 'use base' which is compile time
+            if ($self->left_base_classes || $self->additional_base_classes) {
+                $src_text .= qq|\nBEGIN { extends '$result_base_class' }\n\n|;
+            }
+            else {
+                $src_text .= qq|\nextends '$result_base_class';\n\n|;
+            }
         }
         else {
              $src_text .= qq|use base '$result_base_class';\n\n|;
@@ -1432,11 +1439,13 @@ sub _use {
 sub _inject {
     my $self = shift;
     my $target = shift;
-    my $schema_class = $self->schema_class;
 
     my $blist = join(q{ }, @_);
-    warn "$target: use base qw/ $blist /;" if $self->debug && @_;
-    $self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
+
+    return unless $blist;
+
+    warn "$target: use base qw/$blist/;" if $self->debug;
+    $self->_raw_stmt($target, "use base qw/$blist/;");
 }
 
 sub _result_namespace {
@@ -1530,7 +1539,7 @@ sub _resolve_col_accessor_collisions {
 
     my @methods;
 
-    for my $class ($base, @components) {
+    for my $class ($base, @components, $self->use_moose ? 'Moose::Object' : ()) {
         eval "require ${class};";
         die $@ if $@;
 
@@ -1540,6 +1549,9 @@ sub _resolve_col_accessor_collisions {
     my %methods;
     @methods{@methods} = ();
 
+    # futureproof meta
+    $methods{meta} = undef;
+
     while (my ($col, $info) = each %$col_info) {
         my $accessor = $info->{accessor} || $col;
 
diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index ae299b9..3cf50e5 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -88,7 +88,7 @@ sub run_tests {
 
     my $extra_count = $self->{extra}{count} || 0;
 
-    plan tests => @connect_info * (181 + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+    plan tests => @connect_info * (182 + $extra_count + ($self->{data_type_tests}{test_count} || 0));
 
     foreach my $info_idx (0..$#connect_info) {
         my $info = $connect_info[$info_idx];
@@ -175,6 +175,13 @@ sub setup_schema {
 
     my $debug = ($self->{verbose} > 1) ? 1 : 0;
 
+    eval <<'EOF';
+require Moose;
+require MooseX::NonMoose;
+require namespace::autoclean;
+EOF
+    my $use_moose = $@ ? 0 : 1;
+
     my %loader_opts = (
         constraint              =>
 	    qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)_?)?loader_?test[0-9]+(?!.*_)/i,
@@ -193,6 +200,7 @@ sub setup_schema {
         dump_directory          => $DUMP_DIR,
         datetime_timezone       => 'Europe/Berlin',
         datetime_locale         => 'de_DE',
+        use_moose               => $use_moose,
         %{ $self->{loader_options} || {} },
     );
 
@@ -317,7 +325,7 @@ sub test_schema {
     isa_ok( $rsobj35, "DBIx::Class::ResultSet" );
 
     my @columns_lt2 = $class2->columns;
-    is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key dbix_class_testcomponent/ ], "Column Ordering" );
+    is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key dbix_class_testcomponent meta/ ], "Column Ordering" );
 
     is $class2->column_info('set_primary_key')->{accessor}, undef,
         'accessor for column name that conflicts with a result base class method removed';
@@ -325,6 +333,9 @@ sub test_schema {
     is $class2->column_info('dbix_class_testcomponent')->{accessor}, undef,
         'accessor for column name that conflicts with a component class method removed';
 
+    is $class2->column_info('meta')->{accessor}, undef,
+        'accessor for column name that conflicts with Moose removed';
+
     my %uniq1 = $class1->unique_constraints;
     my $uniq1_test = 0;
     foreach my $ucname (keys %uniq1) {
@@ -1178,6 +1189,7 @@ sub create {
                 dat2 VARCHAR(32) NOT NULL,
                 set_primary_key INTEGER $self->{null},
                 dbix_class_testcomponent INTEGER $self->{null},
+                meta $self->{null},
                 UNIQUE (dat2, dat)
             ) $self->{innodb}
         },