use Class::Unload;
require DBIx::Class;
-our $VERSION = '0.04999_07';
+our $VERSION = '0.04999_10';
__PACKAGE__->mk_ro_accessors(qw/
schema
_tables
classes
monikers
+ dynamic
/);
+__PACKAGE__->mk_accessors(qw/
+ version_to_dump
+/);
+
=head1 NAME
DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
Skip setting up relationships. The default is to attempt the loading
of relationships.
+=head2 naming
+
+Static schemas (ones dumped to disk) will, by default, use the new-style 0.05XXX
+relationship names and singularized Results, unless you're overwriting an
+existing dump made by a 0.04XXX version of L<DBIx::Class::Schema::Loader>, in
+which case the backward compatible RelBuilder will be activated, and
+singularization will be turned off.
+
+Specifying
+
+ naming => 'v5'
+
+will disable the backward-compatible RelBuilder and use
+the new-style relationship names along with singularized Results, even when
+overwriting a dump made with an earlier version.
+
+The option also takes a hashref:
+
+ naming => { relationships => 'v5', results => 'v4' }
+
+The values can be:
+
+=over 4
+
+=item current
+
+Latest default style, whatever that happens to be.
+
+=item v5
+
+Version 0.05XXX style.
+
+=item v4
+
+Version 0.04XXX style.
+
+=back
+
+Dynamic schemas will always default to the 0.04XXX relationship names and won't
+singularize Results for backward compatibility, to activate the new RelBuilder
+and singularization put this in your C<Schema.pm> file:
+
+ __PACKAGE__->naming('current');
+
+Or if you prefer to use 0.05XXX features but insure that nothing breaks in the
+next major version upgrade:
+
+ __PACKAGE__->naming('v5');
+
=head2 debug
If set to true, each constructive L<DBIx::Class> statement the loader
if $self->{dump_overwrite};
$self->{dynamic} = ! $self->{dump_directory};
- $self->{dump_directory} ||= File::Temp::tempdir( 'dbicXXXX',
+ $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
TMPDIR => 1,
CLEANUP => 1,
);
- $self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new(
- $self->schema, $self->inflect_plural, $self->inflect_singular
- ) if !$self->{skip_relationships};
+ $self->{dump_directory} ||= $self->{temp_directory};
+
+ $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
+
+ $self->_check_back_compat;
$self;
}
+sub _check_back_compat {
+ my ($self) = @_;
+
+# dynamic schemas will always be in 0.04006 mode
+ if ($self->dynamic) {
+ no strict 'refs';
+ my $class = ref $self || $self;
+ require DBIx::Class::Schema::Loader::Compat::v0_040;
+ unshift @{"${class}::ISA"},
+ 'DBIx::Class::Schema::Loader::Compat::v0_040';
+ Class::C3::reinitialize;
+# just in case, though no one is likely to dump a dynamic schema
+ $self->version_to_dump('0.04006');
+ return;
+ }
+
+# otherwise check if we need backcompat mode for a static schema
+ my $filename = $self->_get_dump_filename($self->schema_class);
+ return unless -e $filename;
+
+ open(my $fh, '<', $filename)
+ or croak "Cannot open '$filename' for reading: $!";
+
+ while (<$fh>) {
+ if (/^# Created by DBIx::Class::Schema::Loader v((\d+)\.(\d+))/) {
+ my $real_ver = $1;
+ my $ver = "v${2}_${3}";
+ while (1) {
+ my $compat_class = "DBIx::Class::Schema::Loader::Compat::${ver}";
+ if ($self->load_optional_class($compat_class)) {
+ no strict 'refs';
+ my $class = ref $self || $self;
+ unshift @{"${class}::ISA"}, $compat_class;
+ Class::C3::reinitialize;
+ $self->version_to_dump($real_ver);
+ last;
+ }
+ $ver =~ s/\d\z// or last;
+ }
+ last;
+ }
+ }
+ close $fh;
+}
+
sub _find_file_in_inc {
my ($self, $file) = @_;
return;
}
-sub _load_external {
+sub _class_path {
my ($self, $class) = @_;
my $class_path = $class;
$class_path =~ s{::}{/}g;
$class_path .= '.pm';
- my $real_inc_path = $self->_find_file_in_inc($class_path);
+ return $class_path;
+}
+
+sub _find_class_in_inc {
+ my ($self, $class) = @_;
+
+ return $self->_find_file_in_inc($self->_class_path($class));
+}
+
+sub _load_external {
+ my ($self, $class) = @_;
+
+ my $real_inc_path = $self->_find_class_in_inc($class);
return if !$real_inc_path;
warn qq/# Loaded external class definition for '$class'\n/
if $self->debug;
- croak 'Failed to locate actual external module file for '
- . "'$class'"
- if !$real_inc_path;
open(my $fh, '<', $real_inc_path)
or croak "Failed to open '$real_inc_path' for reading: $!";
$self->_ext_stmt($class,
);
close($fh)
or croak "Failed to close $real_inc_path: $!";
+
+# load the class too
+ {
+ # turn off redefined warnings
+ $SIG{__WARN__} = sub {};
+ do $real_inc_path;
+ }
+ die $@ if $@;
}
=head2 load
my ($self, $schema) = @_;
$self->{schema} = $schema;
- $self->{relbuilder}{schema} = $schema;
+ $self->_relbuilder->{schema} = $schema;
my @created;
my @current = $self->_tables_list;
return map { $self->monikers->{$_} } @$loaded;
}
+sub _relbuilder {
+ my ($self) = @_;
+
+ return if $self->{skip_relationships};
+
+ $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder->new(
+ $self->schema, $self->inflect_plural, $self->inflect_singular
+ );
+}
+
sub _load_tables {
my ($self, @tables) = @_;
if(!$self->skip_relationships) {
# The relationship loader needs a working schema
$self->{quiet} = 1;
- $self->_reload_classes(@tables);
+ local $self->{dump_directory} = $self->{temp_directory};
+ $self->_reload_classes(\@tables);
$self->_load_relationships($_) for @tables;
$self->{quiet} = 0;
+
+ # Remove that temp dir from INC so it doesn't get reloaded
+ @INC = grep { $_ ne $self->{dump_directory} } @INC;
}
$self->_load_external($_)
for map { $self->classes->{$_} } @tables;
- $self->_reload_classes(@tables);
+ # Reload without unloading first to preserve any symbols from external
+ # packages.
+ $self->_reload_classes(\@tables, 0);
# Drop temporary cache
delete $self->{_cache};
}
sub _reload_classes {
- my ($self, @tables) = @_;
+ my ($self, $tables, $unload) = @_;
+
+ my @tables = @$tables;
+ $unload = 1 unless defined $unload;
+
+ # so that we don't repeat custom sections
+ @INC = grep $_ ne $self->dump_directory, @INC;
$self->_dump_to_dir(map { $self->classes->{$_} } @tables);
local *Class::C3::reinitialize = sub {};
use warnings;
- Class::Unload->unload($class);
+ Class::Unload->unload($class) if $unload;
my ($source, $resultset_class);
if (
($source = $have_source{$moniker})
&& ($resultset_class ne 'DBIx::Class::ResultSet')
) {
my $has_file = Class::Inspector->loaded_filename($resultset_class);
- Class::Unload->unload($resultset_class);
- $self->ensure_class_loaded($resultset_class) if $has_file;
+ Class::Unload->unload($resultset_class) if $unload;
+ $self->_reload_class($resultset_class) if $has_file;
}
- $self->ensure_class_loaded($class);
+ $self->_reload_class($class);
}
push @to_register, [$moniker, $class];
}
}
}
+# We use this instead of ensure_class_loaded when there are package symbols we
+# want to preserve.
+sub _reload_class {
+ my ($self, $class) = @_;
+
+ my $class_path = $self->_class_path($class);
+ delete $INC{ $class_path };
+ eval "require $class;";
+}
+
sub _get_dump_filename {
my ($self, $class) = (@_);
my $schema_text =
qq|package $schema_class;\n\n|
+ . qq|# Created by DBIx::Class::Schema::Loader\n|
+ . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
. qq|use strict;\nuse warnings;\n\n|
. qq|use base '$schema_base_class';\n\n|;
foreach my $src_class (@classes) {
my $src_text =
qq|package $src_class;\n\n|
+ . qq|# Created by DBIx::Class::Schema::Loader\n|
+ . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
. qq|use strict;\nuse warnings;\n\n|
. qq|use base '$result_base_class';\n\n|;
}
+sub _sig_comment {
+ my ($self, $version, $ts) = @_;
+ return qq|\n\n# Created by DBIx::Class::Schema::Loader|
+ . qq| v| . $version
+ . q| @ | . $ts
+ . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
+}
+
sub _write_classfile {
my ($self, $class, $text) = @_;
unlink($filename);
}
- my $custom_content = $self->_get_custom_content($class, $filename);
- $custom_content ||= qq|\n\n# You can replace this text with custom|
- . qq| content, and it will be preserved on regeneration|
- . qq|\n1;\n|;
+ my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename);
$text .= qq|$_\n|
for @{$self->{_dump_storage}->{$class} || []};
- $text .= qq|\n\n# Created by DBIx::Class::Schema::Loader|
- . qq| v| . $DBIx::Class::Schema::Loader::VERSION
- . q| @ | . POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
- . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
+ # Check and see if the dump is infact differnt
+
+ 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;
+ }
+ }
+
+ $text .= $self->_sig_comment(
+ $self->version_to_dump,
+ POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
+ );
open(my $fh, '>', $filename)
or croak "Cannot open '$filename' for writing: $!";
or croak "Error closing '$filename': $!";
}
+sub _default_custom_content {
+ return qq|\n\n# You can replace this text with custom|
+ . qq| content, and it will be preserved on regeneration|
+ . qq|\n1;\n|;
+}
+
sub _get_custom_content {
my ($self, $class, $filename) = @_;
- return if ! -f $filename;
+ return ($self->_default_custom_content) if ! -f $filename;
+
open(my $fh, '<', $filename)
or croak "Cannot open '$filename' for reading: $!";
my $mark_re =
qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
- my $found = 0;
my $buffer = '';
+ my ($md5, $ts, $ver);
while(<$fh>) {
- if(!$found && /$mark_re/) {
- $found = 1;
- $buffer .= $1;
+ if(!$md5 && /$mark_re/) {
+ $md5 = $2;
+ my $line = $1;
+
+ # Pull out the previous version and timestamp
+ ($ver, $ts) = $buffer =~ m/# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)$/s;
+
+ $buffer .= $line;
croak "Checksum mismatch in '$filename'"
- if Digest::MD5::md5_base64($buffer) ne $2;
+ if Digest::MD5::md5_base64($buffer) ne $md5;
$buffer = '';
}
croak "Cannot not overwrite '$filename' without 'really_erase_my_files',"
. " it does not appear to have been generated by Loader"
- if !$found;
+ if !$md5;
+
+ # Default custom content:
+ $buffer ||= $self->_default_custom_content;
- return $buffer;
+ return ($buffer, $md5, $ver, $ts);
}
sub _use {
my $tbl_uniq_info = $self->_table_uniq_info($table);
my $local_moniker = $self->monikers->{$table};
- my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
+ my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
foreach my $src_class (sort keys %$rel_stmts) {
my $src_stmts = $rel_stmts->{$src_class};
L<DBIx::Class::Schema::Loader>
+=head1 AUTHOR
+
+See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
=cut
1;
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff