schema_version_to_dump
_upgrading_from
_upgrading_from_load_classes
+ _downgrading_to_load_classes
use_namespaces
/);
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+)/) {
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])/;
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 };
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;
$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};
}
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));
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;
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;
'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';
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
}
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';
+
+ 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 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';
}
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;
# 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 {
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff