use Class::Unload;
require DBIx::Class;
-our $VERSION = '0.04999_10';
+our $VERSION = '0.04999_11';
__PACKAGE__->mk_ro_accessors(qw/
schema
_tables
classes
monikers
+ dynamic
/);
__PACKAGE__->mk_accessors(qw/
my ($self) = @_;
# dynamic schemas will always be in 0.04006 mode
- if ($self->{dynamic}) {
+ 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;
}
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: $!";
+
+ if ($self->dynamic) { # load the class too
+ # turn off redefined warnings
+ local $SIG{__WARN__} = sub {};
+ do $real_inc_path;
+ die $@ if $@;
+ }
}
=head2 load
# The relationship loader needs a working schema
$self->{quiet} = 1;
local $self->{dump_directory} = $self->{temp_directory};
- $self->_reload_classes(@tables);
+ $self->_reload_classes(\@tables);
$self->_load_relationships($_) for @tables;
$self->{quiet} = 0;
$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;
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 $self = shift;
my $class = shift;
my $method = shift;
-
+ if ( $method eq 'table' ) {
+ my ($table) = @_;
+ $self->_pod( $class, "=head1 NAME" );
+ my $table_descr = $class;
+ if ( $self->can('_table_comment') ) {
+ my $comment = $self->_table_comment($table);
+ $table_descr .= " - " . $comment if $comment;
+ }
+ $self->{_class2table}{ $class } = $table;
+ $self->_pod( $class, $table_descr );
+ $self->_pod_cut( $class );
+ } elsif ( $method eq 'add_columns' ) {
+ $self->_pod( $class, "=head1 ACCESSORS" );
+ my $i = 0;
+ foreach ( @_ ) {
+ $i++;
+ next unless $i % 2;
+ $self->_pod( $class, '=head2 ' . $_ );
+ my $comment;
+ $comment = $self->_column_comment( $self->{_class2table}{$class}, ($i - 1) / 2 + 1 ) if $self->can('_column_comment');
+ $self->_pod( $class, $comment ) if $comment;
+ }
+ $self->_pod_cut( $class );
+ } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
+ $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
+ my ( $accessor, $rel_class ) = @_;
+ $self->_pod( $class, "=head2 $accessor" );
+ $self->_pod( $class, 'Type: ' . $method );
+ $self->_pod( $class, "Related object: L<$rel_class>" );
+ $self->_pod_cut( $class );
+ $self->{_relations_started} { $class } = 1;
+ }
my $args = dump(@_);
$args = '(' . $args . ')' if @_ < 2;
my $stmt = $method . $args . q{;};
warn qq|$class\->$stmt\n| if $self->debug;
$self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
+ return;
+}
+
+# Stores a POD documentation
+sub _pod {
+ my ($self, $class, $stmt) = @_;
+ $self->_raw_stmt( $class, "\n" . $stmt );
}
+sub _pod_cut {
+ my ($self, $class ) = @_;
+ $self->_raw_stmt( $class, "\n=cut\n" );
+}
+
+
# Store a raw source line for a class (for dumping purposes)
sub _raw_stmt {
my ($self, $class, $stmt) = @_;
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff