[Bast-commits] r8287 - in branches/DBIx-Class-Schema-Loader/current: lib/DBIx/Class/Schema/Loader t

caelum at dev.catalyst.perl.org caelum at dev.catalyst.perl.org
Tue Jan 12 22:48:25 GMT 2010


Author: caelum
Date: 2010-01-12 22:48:25 +0000 (Tue, 12 Jan 2010)
New Revision: 8287

Modified:
   branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
   branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t
Log:
support downgrade from use_namespaces

Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm	2010-01-12 17:04:18 UTC (rev 8286)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm	2010-01-12 22:48:25 UTC (rev 8287)
@@ -62,6 +62,7 @@
                                 schema_version_to_dump
                                 _upgrading_from
                                 _upgrading_from_load_classes
+                                _downgrading_to_load_classes
                                 use_namespaces
 /);
 
@@ -468,10 +469,12 @@
         or croak "Cannot open '$filename' for reading: $!";
 
     my $load_classes = 0;
+    my $result_namespace;
 
     while (<$fh>) {
         if (/^__PACKAGE__->load_classes;/) {
             $load_classes = 1;
+        } elsif (($result_namespace) = /result_namespace => '([^']+)'/) {
         } elsif (my ($real_ver) =
                 /^# Created by DBIx::Class::Schema::Loader v(\d+\.\d+)/) {
 
@@ -491,6 +494,11 @@
             elsif ($load_classes && $self->use_namespaces) {
                 $self->_upgrading_from_load_classes(1);
             }
+            elsif ((not $load_classes) && (not $self->use_namespaces)) {
+                $self->_downgrading_to_load_classes(
+                    $result_namespace || 'Result'
+                );
+            }
 
             # XXX when we go past .0 this will need fixing
             my ($v) = $real_ver =~ /([1-9])/;
@@ -555,10 +563,18 @@
     return $self->_find_file_in_inc($self->_class_path($class));
 }
 
+sub _rewriting {
+    my $self = shift;
+
+    return $self->_upgrading_from
+        || $self->_upgrading_from_load_classes
+        || $self->_downgrading_to_load_classes;
+}
+
 sub _rewrite_old_classnames {
     my ($self, $code) = @_;
 
-    return $code unless $self->_upgrading_from;
+    return $code unless $self->_rewriting;
 
     my %old_classes = reverse %{ $self->_upgrading_classes };
 
@@ -581,7 +597,7 @@
     my $real_inc_path = $self->_find_class_in_inc($class);
 
     my $old_class = $self->_upgrading_classes->{$class}
-        if $self->_upgrading_from;
+        if $self->_rewriting;
 
     my $old_real_inc_path = $self->_find_class_in_inc($old_class)
         if $old_class && $old_class ne $class;
@@ -924,6 +940,26 @@
         $self->_write_classfile($src_class, $src_text);
     }
 
+    # remove Result dir if downgrading from use_namespaces, and there are no
+    # files left.
+    if (my $result_ns = $self->_downgrading_to_load_classes) {
+        my $result_class;
+
+        if ($result_ns =~ /^\+(.*)/) {
+            $result_class = $1;
+        }
+        else {
+            $result_class = "${schema_class}::${result_ns}";
+        }
+
+        (my $result_dir = $result_class) =~ s{::}{/}g;
+        $result_dir = $self->dump_directory . '/' . $result_dir;
+
+        unless (my @files = glob "$result_dir/*") {
+            rmdir $result_dir;
+        }
+    }
+
     warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
 
 }
@@ -1099,13 +1135,24 @@
     my $table_class = join(q{::}, @result_namespace, $table_moniker);
 
     if ((my $upgrading_v = $self->_upgrading_from)
-            || $self->_upgrading_from_load_classes) {
+            || $self->_rewriting) {
         local $self->naming->{monikers} = $upgrading_v
             if $upgrading_v;
 
         my @result_namespace = @result_namespace;
-        @result_namespace = ($schema_class)
-            if $self->_upgrading_from_load_classes;
+        if ($self->_upgrading_from_load_classes) {
+            @result_namespace = ($schema_class);
+        }
+        elsif (my $ns = $self->_downgrading_to_load_classes) {
+            if ($ns =~ /^\+(.*)/) {
+                # Fully qualified namespace
+                @result_namespace = ($1)
+            }
+            else {
+                # Relative namespace
+                @result_namespace = ($schema_class, $ns);
+            }
+        }
 
         my $old_class = join(q{::}, @result_namespace,
             $self->_table2moniker($table));

Modified: branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t	2010-01-12 17:04:18 UTC (rev 8286)
+++ branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t	2010-01-12 22:48:25 UTC (rev 8287)
@@ -127,7 +127,7 @@
 package ${SCHEMA_CLASS}::Quuxs;
 sub a_method { 'hlagh' }
 
-__PACKAGE__->has_one('bazrel', 'DBIXCSL_Test::Schema::Bazs',
+__PACKAGE__->has_one('bazrel4', 'DBIXCSL_Test::Schema::Bazs',
     { 'foreign.baz_num' => 'self.baz_id' });
 
 1;
@@ -137,7 +137,7 @@
     IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
 package ${SCHEMA_CLASS}::Bar;
 
-__PACKAGE__->has_one('foorel', 'DBIXCSL_Test::Schema::Foos',
+__PACKAGE__->has_one('foorel4', 'DBIXCSL_Test::Schema::Foos',
     { 'foreign.fooid' => 'self.foo_id' });
 
 1;
@@ -158,11 +158,11 @@
 'external custom content for unsingularized Result was loaded by upgraded ' .
 'dynamic Schema';
 
-    lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel,
+    lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel4,
         $res->{classes}{bazs} }
         'unsingularized class names in external content are translated';
 
-    lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel,
+    lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel4,
         $res->{classes}{foos} }
 'unsingularized class names in external content from unchanged Result class ' .
 'names are translated';
@@ -353,7 +353,7 @@
                 print <<EOF;
 sub a_method { 'mtfnpy' }
 
-__PACKAGE__->has_one('bazrel3', 'DBIXCSL_Test::Schema::Bazs',
+__PACKAGE__->has_one('bazrel5', 'DBIXCSL_Test::Schema::Bazs',
     { 'foreign.baz_num' => 'self.baz_id' });
 EOF
             }
@@ -398,7 +398,7 @@
     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
         'custom content was carried over from un-singularized Result';
 
-    lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel3,
+    lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel5,
         $res->{classes}{bazs} }
         'unsingularized class names in custom content are translated';
 
@@ -409,6 +409,93 @@
 'custom content from unsingularized Result loaded into static dump correctly';
 }
 
+# test running against v4 schema with load_namespaces, upgrade to v5 but
+# downgrade to load_classes
+{
+    write_v4_schema_pm(use_namespaces => 1);
+    my $res = run_loader(dump_directory => $DUMP_DIR);
+    my $warning = $res->{warnings}[0];
+
+    like $warning, qr/static schema/i,
+        'static schema in backcompat mode detected';
+    like $warning, qr/0.04006/,
+        'correct version detected';
+    like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
+        'refers to upgrading doc';
+
+    is scalar @{ $res->{warnings} }, 3,
+        'correct number of warnings for static schema in backcompat mode';
+
+    run_v4_tests($res);
+
+    # add some custom content to a Result that will be replaced
+    my $schema   = $res->{schema};
+    my $quuxs_pm = $schema->_loader
+        ->_get_dump_filename($res->{classes}{quuxs});
+    {
+        local ($^I, @ARGV) = ('', $quuxs_pm);
+        while (<>) {
+            if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
+                print;
+                print <<EOF;
+sub a_method { 'mtfnpy' }
+
+__PACKAGE__->has_one('bazrel6', 'DBIXCSL_Test::Schema::Result::Bazs',
+    { 'foreign.baz_num' => 'self.baz_id' });
+EOF
+            }
+            else {
+                print;
+            }
+        }
+    }
+
+    # now upgrade the schema to v5 but downgrade to load_classes
+    $res = run_loader(
+        dump_directory => $DUMP_DIR,
+        naming => 'current',
+        use_namespaces => 0,
+    );
+    $schema = $res->{schema};
+
+    like $res->{warnings}[0], qr/Dumping manual schema/i,
+'correct warnings on upgrading static schema (with "naming" set and ' .
+'use_namespaces => 0)';
+
+    like $res->{warnings}[1], qr/dump completed/i,
+'correct warnings on upgrading static schema (with "naming" set and ' .
+'use_namespaces => 0)';
+
+    is scalar @{ $res->{warnings} }, 2,
+'correct number of warnings on upgrading static schema (with "naming" set)'
+        or diag @{ $res->{warnings} };
+
+    run_v5_tests($res);
+
+    (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
+    my $result_count =()= glob "$result_dir/*";
+
+    is $result_count, 4,
+'un-singularized results were replaced during upgrade and Result dir removed';
+
+    ok ((not -d "$result_dir/Result"),
+        'Result dir was removed for load_classes downgrade');
+
+    # check that custom content was preserved
+    lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
+        'custom content was carried over from un-singularized Result';
+
+    lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel6,
+        $res->{classes}{bazs} }
+        'unsingularized class names in custom content are translated';
+
+    my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
+    my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+
+    like $code, qr/sub a_method { 'mtfnpy' }/,
+'custom content from unsingularized Result loaded into static dump correctly';
+}
+
 # test upgrading a v4 schema, the check that the version string is correct
 {
     write_v4_schema_pm();
@@ -525,12 +612,15 @@
 }
 
 sub write_v4_schema_pm {
+    my %opts = @_;
+
     (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//;
     rmtree $schema_dir;
     make_path $schema_dir;
     my $schema_pm = "$schema_dir/Schema.pm";
     open my $fh, '>', $schema_pm or die $!;
-    print $fh <<'EOF';
+    if (not $opts{use_namespaces}) {
+        print $fh <<'EOF';
 package DBIXCSL_Test::Schema;
 
 use strict;
@@ -548,6 +638,28 @@
 # You can replace this text with custom content, and it will be preserved on regeneration
 1;
 EOF
+    }
+    else {
+        print $fh <<'EOF';
+package DBIXCSL_Test::Schema;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Schema';
+
+__PACKAGE__->load_namespaces;
+
+
+# Created by DBIx::Class::Schema::Loader v0.04006 @ 2010-01-12 16:04:12
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:d3wRVsHBNisyhxeaWJZcZQ
+
+
+# You can replace this text with custom content, and it will be preserved on
+# regeneration
+1;
+EOF
+    }
 }
 
 sub run_v4_tests {




More information about the Bast-commits mailing list