schema_base_class
result_base_class
use_moose
- overwrite_modifications
+ overwrite_modifications
relationship_attrs
my $self = { %args };
+ # don't lose undef options
+ for (values %$self) {
+ $_ = 0 unless defined $_;
+ }
+
bless $self => $class;
if (my $config_file = $self->config_file) {
my $filename = $self->_get_dump_filename($self->schema_class);
return unless -e $filename;
- open(my $fh, '<', $filename)
- or croak "Cannot open '$filename' for reading: $!";
+ my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) =
+ $self->_parse_generated_file($filename);
- my $load_classes = 0;
- my $result_namespace = '';
+ return unless $old_ver;
+
+ # determine if the existing schema was dumped with use_moose => 1
+ if (! defined $self->use_moose) {
+ $self->use_moose(1) if $old_gen =~ /^ (?!\s*\#) use \s+ Moose/xm;
+ }
- while (<$fh>) {
- if (/^__PACKAGE__->load_classes;/) {
- $load_classes = 1;
- } elsif (/result_namespace => '([^']+)'/) {
- $result_namespace = $1;
- } elsif (my ($real_ver) =
- /^# Created by DBIx::Class::Schema::Loader v(\d+\.\d+)/) {
+ my $load_classes = ($old_gen =~ /^__PACKAGE__->load_classes;/m) ? 1 : 0;
+ my $result_namespace = do { ($old_gen =~ /result_namespace => '([^']+)'/) ? $1 : '' };
- if ($load_classes && (not defined $self->use_namespaces)) {
- warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
+ if ($load_classes && (not defined $self->use_namespaces)) {
+ warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
'load_classes;' static schema detected, turning off 'use_namespaces'.
See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
details.
EOF
- $self->use_namespaces(0);
- }
- elsif ($load_classes && $self->use_namespaces) {
- $self->_upgrading_from_load_classes(1);
- }
- elsif ((not $load_classes) && defined $self->use_namespaces
- && (not $self->use_namespaces)) {
- $self->_downgrading_to_load_classes(
- $result_namespace || 'Result'
- );
- }
- elsif ((not defined $self->use_namespaces)
- || $self->use_namespaces) {
- if (not $self->result_namespace) {
- $self->result_namespace($result_namespace || 'Result');
- }
- elsif ($result_namespace ne $self->result_namespace) {
- $self->_rewriting_result_namespace(
- $result_namespace || 'Result'
- );
- }
- }
+ $self->use_namespaces(0);
+ }
+ elsif ($load_classes && $self->use_namespaces) {
+ $self->_upgrading_from_load_classes(1);
+ }
+ elsif ((not $load_classes) && defined $self->use_namespaces && ! $self->use_namespaces) {
+ $self->_downgrading_to_load_classes(
+ $result_namespace || 'Result'
+ );
+ }
+ elsif ((not defined $self->use_namespaces) || $self->use_namespaces) {
+ if (not $self->result_namespace) {
+ $self->result_namespace($result_namespace || 'Result');
+ }
+ elsif ($result_namespace ne $self->result_namespace) {
+ $self->_rewriting_result_namespace(
+ $result_namespace || 'Result'
+ );
+ }
+ }
- # XXX when we go past .0 this will need fixing
- my ($v) = $real_ver =~ /([1-9])/;
- $v = "v$v";
+ # XXX when we go past .0 this will need fixing
+ my ($v) = $old_ver =~ /([1-9])/;
+ $v = "v$v";
- last if $v eq $CURRENT_V || $real_ver =~ /^0\.\d\d999/;
+ return if ($v eq $CURRENT_V || $old_ver =~ /^0\.\d\d999/);
- if (not %{ $self->naming }) {
- warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
+ if (not %{ $self->naming }) {
+ warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
-Version $real_ver static schema detected, turning on backcompat mode.
+Version $old_ver static schema detected, turning on backcompat mode.
Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
to disable this warning.
See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 if upgrading
from version 0.04006.
EOF
- }
- else {
- $self->_upgrading_from($v);
- last;
- }
-
- $self->naming->{relationships} ||= $v;
- $self->naming->{monikers} ||= $v;
- $self->naming->{column_accessors} ||= $v;
- $self->schema_version_to_dump($real_ver);
+ $self->naming->{relationships} ||= $v;
+ $self->naming->{monikers} ||= $v;
+ $self->naming->{column_accessors} ||= $v;
- last;
- }
+ $self->schema_version_to_dump($old_ver);
+ }
+ else {
+ $self->_upgrading_from($v);
}
- close $fh;
}
sub _validate_class_args {
my $self = shift;
my $args = shift;
-
+
foreach my $k (@CLASS_ARGS) {
next unless $self->$k;
warn "Deleting existing file '$filename' due to "
. "'really_erase_my_files' setting\n" unless $self->{quiet};
unlink($filename);
- }
+ }
- my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename);
+ my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom)
+ = $self->_parse_generated_file($filename);
- # If upgrading to use_moose=1 replace default custom content with default Moose custom content.
- # If there is already custom content, which does not have the Moose content, add it.
- if ($self->use_moose) {
- local $self->{use_moose} = 0;
+ if (! $old_gen && -f $filename) {
+ croak "Cannot overwrite '$filename' without 'really_erase_my_files',"
+ . " it does not appear to have been generated by Loader"
+ }
- if ($custom_content eq $self->_default_custom_content) {
- local $self->{use_moose} = 1;
+ my $custom_content = $old_custom || '';
- $custom_content = $self->_default_custom_content;
- }
- else {
- local $self->{use_moose} = 1;
+ # prepend extra custom content from a *renamed* class (singularization effect)
+ if (my $renamed_class = $self->_upgrading_classes->{$class}) {
+ my $old_filename = $self->_get_dump_filename($renamed_class);
- if ($custom_content !~ /\Q@{[$self->_default_moose_custom_content]}\E/) {
- $custom_content .= $self->_default_custom_content;
- }
+ if (-f $old_filename) {
+ my $extra_custom = ($self->_parse_generated_file ($old_filename))[4];
+
+ $extra_custom =~ s/\n\n# You can replace.*\n1;\n//;
+
+ $custom_content = join ("\n", '', $extra_custom, $custom_content)
+ if $extra_custom;
+
+ unlink $old_filename;
}
}
- if (my $old_class = $self->_upgrading_classes->{$class}) {
- my $old_filename = $self->_get_dump_filename($old_class);
+ $custom_content ||= $self->_default_custom_content;
- my ($old_custom_content) = $self->_get_custom_content(
- $old_class, $old_filename, 0 # do not add default comment
- );
+ # If upgrading to use_moose=1 replace default custom content with default Moose custom content.
+ # If there is already custom content, which does not have the Moose content, add it.
+ if ($self->use_moose) {
- $old_custom_content =~ s/\n\n# You can replace.*\n1;\n//;
+ my $non_moose_custom_content = do {
+ local $self->{use_moose} = 0;
+ $self->_default_custom_content;
+ };
- if ($old_custom_content) {
- $custom_content =
- "\n" . $old_custom_content . "\n" . $custom_content;
+ if ($custom_content eq $non_moose_custom_content) {
+ $custom_content = $self->_default_custom_content;
+ }
+ elsif ($custom_content !~ /\Q@{[$self->_default_moose_custom_content]}\E/) {
+ $custom_content .= $self->_default_custom_content;
}
-
- unlink $old_filename;
}
$custom_content = $self->_rewrite_old_classnames($custom_content);
my $compare_to;
if ($old_md5) {
$compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
-
-
if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
return unless $self->_upgrading_from && $is_schema;
}
return $default;
}
-sub _get_custom_content {
- my ($self, $class, $filename, $add_default) = @_;
-
- $add_default = 1 unless defined $add_default;
+sub _parse_generated_file {
+ my ($self, $fn) = @_;
- return ($self->_default_custom_content) if ! -f $filename;
+ return unless -f $fn;
- open(my $fh, '<', $filename)
- or croak "Cannot open '$filename' for reading: $!";
+ open(my $fh, '<', $fn)
+ or croak "Cannot open '$fn' for reading: $!";
- my $mark_re =
+ my $mark_re =
qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
- my $buffer = '';
- my ($md5, $ts, $ver);
+ my ($md5, $ts, $ver, $gen);
while(<$fh>) {
- if(!$md5 && /$mark_re/) {
+ if(/$mark_re/) {
+ my $pre_md5 = $1;
$md5 = $2;
- my $line = $1;
- # Pull out the previous version and timestamp
- ($ver, $ts) = $buffer =~ m/# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)$/s;
+ # Pull out the version and timestamp from the line above
+ ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\Z/m;
- $buffer .= $line;
- croak "Checksum mismatch in '$filename', the auto-generated part of the file has been modified outside of this loader. Aborting.\nIf you want to overwrite these modifications, set the 'overwrite_modifications' loader option.\n"
- if !$self->overwrite_modifications && Digest::MD5::md5_base64($buffer) ne $md5;
+ $gen .= $pre_md5;
+ croak "Checksum mismatch in '$fn', the auto-generated part of the file has been modified outside of this loader. Aborting.\nIf you want to overwrite these modifications, set the 'overwrite_modifications' loader option.\n"
+ if !$self->overwrite_modifications && Digest::MD5::md5_base64($gen) ne $md5;
- $buffer = '';
+ last;
}
else {
- $buffer .= $_;
+ $gen .= $_;
}
}
- croak "Cannot not overwrite '$filename' without 'really_erase_my_files',"
- . " it does not appear to have been generated by Loader"
- if !$md5;
+ my $custom = do { local $/; <$fh> }
+ if $md5;
- # Default custom content:
- $buffer ||= $self->_default_custom_content if $add_default;
+ close ($fh);
- return ($buffer, $md5, $ver, $ts);
+ return ($gen, $md5, $ver, $ts, $custom);
}
sub _use {
);
# add Moose custom content then check it is not repeated
-
+# after that regen again *without* the use_moose flag, make
+# sure moose isn't stripped away
$t->append_to_class('DBICTest::DumpMore::1::Foo', qq{__PACKAGE__->meta->make_immutable;\n1;\n});
-$t->dump_test(
- classname => 'DBICTest::DumpMore::1',
- options => {
- use_moose => 1,
- result_base_class => 'My::ResultBaseClass',
- schema_base_class => 'My::SchemaBaseClass',
- },
- warnings => [
- qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
- qr/Schema dump completed/,
- ],
- regexes => {
- schema => [
- qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/,
- qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
- ],
- Foo => [
- qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
- qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
- ],
- Bar => [
- qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
- qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
- ],
- },
- neg_regexes => {
- Foo => [
- qr/\n__PACKAGE__->meta->make_immutable;\n.*\n__PACKAGE__->meta->make_immutable;/s,
- ],
- },
-);
+for my $supply_use_moose (1, 0) {
+ $t->dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => {
+ $supply_use_moose ? (use_moose => 1) : (),
+ result_base_class => 'My::ResultBaseClass',
+ schema_base_class => 'My::SchemaBaseClass',
+ },
+ warnings => [
+ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+ qr/Schema dump completed/,
+ ],
+ regexes => {
+ schema => [
+ qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/,
+ qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
+ ],
+ Foo => [
+ qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
+ qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
+ ],
+ Bar => [
+ qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
+ qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
+ ],
+ },
+ neg_regexes => {
+ Foo => [
+ qr/\n__PACKAGE__->meta->make_immutable;\n.*\n__PACKAGE__->meta->make_immutable;/s,
+ ],
+ },
+ );
+}
done_testing;
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff