Skip loading of other classes in @INC. The default is to merge all other classes
with the same name found in @INC into the schema file we are creating.
+Even if this is not set, code generated by this module and not
+subsequently modified is never included.
+
=head2 naming
Static schemas (ones dumped to disk) will, by default, use the new-style
my $code = $self->_rewrite_old_classnames(slurp_file $real_inc_path);
- if ($self->dynamic) { # load the class too
- eval_package_without_redefine_warnings($class, $code);
+ if (my ($gen, $real_md5, $ver, $ts, $custom) = try {
+ local $self->{overwrite_modifications} = 0;
+ $self->_parse_generated_code($real_inc_path, $code);
+ }) {
+ # Ignore unmodified generated code.
+ $code = $custom eq $self->_default_custom_content ? '' : $custom;
}
- $self->_ext_stmt($class,
- qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
- .qq|# They are now part of the custom portion of this file\n|
- .qq|# for you to hand-edit. If you do not either delete\n|
- .qq|# this section or remove that file from \@INC, this section\n|
- .qq|# will be repeated redundantly when you re-create this\n|
- .qq|# file again via Loader! See skip_load_external to disable\n|
- .qq|# this feature.\n|
- );
- chomp $code;
- $self->_ext_stmt($class, $code);
- $self->_ext_stmt($class,
- qq|# End of lines loaded from '$real_inc_path'|
- );
+ if ($code) {
+ if ($self->dynamic) { # load the class too
+ eval_package_without_redefine_warnings($class, $code);
+ }
+
+ $self->_ext_stmt($class,
+ qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
+ .qq|# They are now part of the custom portion of this file\n|
+ .qq|# for you to hand-edit. If you do not either delete\n|
+ .qq|# this section or remove that file from \@INC, this section\n|
+ .qq|# will be repeated redundantly when you re-create this\n|
+ .qq|# file again via Loader! See skip_load_external to disable\n|
+ .qq|# this feature.\n|
+ );
+ chomp $code;
+ $self->_ext_stmt($class, $code);
+ $self->_ext_stmt($class,
+ qq|# End of lines loaded from '$real_inc_path'|
+ );
+ }
}
if ($old_real_inc_path) {
return unless -f $fn;
- open(my $fh, '<:encoding(UTF-8)', $fn)
- or croak "Cannot open '$fn' for reading: $!";
-
- my $mark_re =
- qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n};
-
- my ($real_md5, $ts, $ver, $gen);
- local $_;
- while(<$fh>) {
- if(/$mark_re/) {
- my $pre_md5 = $1;
- my $mark_md5 = $2;
-
- # Pull out the version and timestamp from the line above
- ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader( v[\d.]+)?( @ [\d-]+ [\d:]+)?\r?\Z/m;
- $ver =~ s/^ v// if $ver;
- $ts =~ s/^ @ // if $ts;
-
- $gen .= $pre_md5;
- $real_md5 = Digest::MD5::md5_base64(encode 'UTF-8', $gen);
- 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 && $real_md5 ne $mark_md5;
-
- last;
- }
- else {
- $gen .= $_;
- }
- }
-
- my $custom = do { local $/; <$fh> }
- if $real_md5;
-
- $custom ||= '';
- $custom =~ s/$CRLF|$LF/\n/g;
-
- close $fh;
+ return $self->_parse_generated_code($fn, slurp_file $fn);
+}
+
+sub _parse_generated_code {
+ my ($self, $fn, $code) = @_;
+
+ my ($gen, $ver, $ts, $mark_md5, $custom) = (
+ $code =~ m{
+ \A
+ (
+ .* # generated code
+ ^\# \Q Created by DBIx::Class::Schema::Loader\E
+ (\ v [\d.]+ )? (\ @\ [\d-]+\ [\d:]+)?\r?\n # verison/time stamp
+ ^\# \Q DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:\E
+ )
+ ([A-Za-z0-9/+]{22})\r?\n # checksum
+ (.*) # custom code
+ \z
+ }xms
+ ) or return;
+
+ $ver =~ s/^ v// if $ver;
+ $ts =~ s/^ @ // if $ts;
+
+ my $real_md5 = Digest::MD5::md5_base64(encode 'UTF-8', $gen);
+ 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 && $real_md5 ne $mark_md5;
return ($gen, $real_md5, $ver, $ts, $custom);
}
use namespace::clean;
use File::Temp ();
use lib qw(t/lib);
+use dbixcsl_test_dir '$tdir';
use dbixcsl_dumper_tests;
my $t = 'dbixcsl_dumper_tests';
},
);
+my $copy = $t->copy_class('DBICTest::DumpMore::1::Foo', 'dump_copy');
+diag $copy;
+unshift @INC, "$tdir/dump_copy";
+
+$t->dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ neg_regexes => {
+ Foo => [
+ qr/^# These lines were loaded from/m,
+ ],
+ },
+);
+
+$t->append_to_class('DBICTest::DumpMore::1::Foo', qq{# XXX This is my external custom content\n}, 'dump_copy');
+
+$t->dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => {
+ really_erase_my_files => 1,
+ },
+ regexes => {
+ Foo => [
+ qr/^# XXX This is my external custom content/m,
+ ],
+ },
+ neg_regexes => {
+ Foo => [
+ qr/^# These lines were loaded from.*^# Created by DBIx::Class::Schema::Loader/,
+ ],
+ },
+);
+
+
done_testing;
# vim:et sts=4 sw=4 tw=0:
use strict;
use warnings;
use Test::More;
+use File::Basename;
+use File::Copy;
use File::Path;
use IPC::Open3;
use IO::Handle;
use dbixcsl_test_dir '$tdir';
-my $DUMP_PATH = "$tdir/dump";
+my $SUB_DIR = 'dump';
+my $DUMP_PATH = "$tdir/$SUB_DIR";
sub cleanup {
rmtree($DUMP_PATH, 1, 1);
}
sub class_file {
- my ($self, $class) = @_;
+ my ($self, $class, $subdir) = @_;
+
+ my $path = $DUMP_PATH;
+ $path =~ s/\Q$SUB_DIR\E\z/$subdir/ if $subdir;
$class =~ s{::}{/}g;
- $class = $DUMP_PATH . '/' . $class . '.pm';
+ $class = $path . '/' . $class . '.pm';
return $class;
}
sub append_to_class {
- my ($self, $class, $string) = @_;
+ my ($self, $class, $string, $destdir) = @_;
- $class = $self->class_file($class);
+ $class = $self->class_file($class, $destdir);
open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
close($appendfh);
}
+sub copy_class {
+ my ($self, $class, $destdir) = @_;
+
+ my $srcfile = $self->class_file($class);
+ my $destfile = $self->class_file($class, $destdir);
+ mkpath(dirname $destfile);
+
+ copy($srcfile, $destfile) or die "Failed to copy '$srcfile' to '$destfile': $!";
+ return $destfile;
+}
+
sub dump_test {
my ($self, %tdata) = @_;
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff