[Bast-commits] r4413 - in
branches/DBIx-Class-Schema-Loader/current: .
lib/DBIx/Class/Schema/Loader
ilmari at dev.catalyst.perl.org
ilmari at dev.catalyst.perl.org
Mon May 26 18:22:12 BST 2008
Author: ilmari
Date: 2008-05-26 18:22:12 +0100 (Mon, 26 May 2008)
New Revision: 4413
Modified:
branches/DBIx-Class-Schema-Loader/current/Changes
branches/DBIx-Class-Schema-Loader/current/Makefile.PL
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
Log:
Throw out the in-memory class generation, just dump to a temporary
directory if the user didn't specify one
Modified: branches/DBIx-Class-Schema-Loader/current/Changes
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/Changes 2008-05-26 03:47:44 UTC (rev 4412)
+++ branches/DBIx-Class-Schema-Loader/current/Changes 2008-05-26 17:22:12 UTC (rev 4413)
@@ -4,6 +4,8 @@
- Singularise table monikers by default
- Strip trailing _id from single-column belongs_to relationships
- Add "dbicdump" script for easy commandline dumping
+ - Throw out the in-memory class generation, just dump to a temporary
+ directory if the user didn't specify one
0.04999_05 Mon Apr 14, 2008
- Fix limiting table list to the specified schema for DB2
Modified: branches/DBIx-Class-Schema-Loader/current/Makefile.PL
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/Makefile.PL 2008-05-26 03:47:44 UTC (rev 4412)
+++ branches/DBIx-Class-Schema-Loader/current/Makefile.PL 2008-05-26 17:22:12 UTC (rev 4413)
@@ -8,7 +8,6 @@
test_requires 'DBI' => '1.56';
test_requires 'DBD::SQLite' => '1.12';
test_requires 'File::Path' => 0;
-test_requires 'Class::Unload' => 0;
test_requires 'IPC::Open3' => 0;
requires 'File::Spec' => 0;
@@ -24,6 +23,7 @@
requires 'Carp::Clan' => 0;
requires 'Class::Inspector' => 0;
requires 'DBIx::Class' => '0.07006';
+requires 'Class::Unload' => 0;
install_script 'script/dbicdump';
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2008-05-26 03:47:44 UTC (rev 4412)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2008-05-26 17:22:12 UTC (rev 4413)
@@ -13,6 +13,8 @@
use Cwd qw//;
use Digest::MD5 qw//;
use Lingua::EN::Inflect::Number qw//;
+use File::Temp qw//;
+use Class::Unload;
require DBIx::Class;
our $VERSION = '0.04999_05';
@@ -253,6 +255,12 @@
. " DBIx::Class::Schema::Loader::Base documentation"
if $self->{dump_overwrite};
+ $self->{dynamic} = ! $self->{dump_directory};
+ $self->{dump_directory} ||= File::Temp::tempdir( 'dbicXXXX',
+ TMPDIR => 1,
+ CLEANUP => 1,
+ );
+
$self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new(
$self->schema_class, $self->inflect_plural, $self->inflect_singular
) if !$self->{skip_relationships};
@@ -264,8 +272,10 @@
my ($self, $file) = @_;
foreach my $prefix (@INC) {
- my $fullpath = $prefix . '/' . $file;
- return $fullpath if -f $fullpath;
+ my $fullpath = File::Spec->catfile($prefix, $file);
+ return $fullpath if -f $fullpath
+ and Cwd::abs_path($fullpath) ne
+ Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) || '';
}
return;
@@ -278,34 +288,14 @@
$class_path =~ s{::}{/}g;
$class_path .= '.pm';
- my $inc_path = $self->_find_file_in_inc($class_path);
+ my $real_inc_path = $self->_find_file_in_inc($class_path);
- return if !$inc_path;
+ return if !$real_inc_path;
- my $real_dump_path = $self->dump_directory
- ? Cwd::abs_path(
- File::Spec->catfile($self->dump_directory, $class_path)
- ) || ''
- : '';
- my $real_inc_path = Cwd::abs_path($inc_path);
- return if $real_inc_path eq $real_dump_path;
-
- $class->require;
- croak "Failed to load external class definition"
- . " for '$class': $@"
- if $@;
-
# If we make it to here, we loaded an external definition
warn qq/# Loaded external class definition for '$class'\n/
if $self->debug;
- # Make sure ResultSetManager picks up any :ResultSet methods from
- # the external definition
- $class->table($class->table);
-
- # The rest is only relevant when dumping
- return if !$self->dump_directory;
-
croak 'Failed to locate actual external module file for '
. "'$class'"
if !$real_inc_path;
@@ -392,34 +382,52 @@
$self->{_tables}->{$_} = 1;
}
- # Set up classes/monikers
- {
- no warnings 'redefine';
- local *Class::C3::reinitialize = sub { };
- use warnings;
-
- $self->_make_src_class($_) for @tables;
- }
-
- Class::C3::reinitialize;
-
+ $self->_make_src_class($_) for @tables;
$self->_setup_src_meta($_) for @tables;
+ my %moniker_class = map { $self->monikers->{$_} => $self->classes->{$_} } @tables;
+
if(!$self->skip_relationships) {
+ # Dump and load what we have so far, so the relationship loader
+ # can get at it, but be quiet
+ $self->{quiet} = 1;
+ $self->_dump_to_dir(values %moniker_class);
+ $self->_reload_classes(\%moniker_class);
$self->_load_relationships($_) for @tables;
+ $self->{quiet} = 0;
}
$self->_load_external($_)
for map { $self->classes->{$_} } @tables;
- $self->_dump_to_dir if $self->dump_directory;
+ $self->_dump_to_dir(values %moniker_class);
+ # Make sure stuff gets reloaded
+ $self->_reload_classes(\%moniker_class);
+
# Drop temporary cache
delete $self->{_cache};
return \@tables;
}
+sub _reload_classes {
+ my ($self, $moniker_class) = @_;
+
+ while (my ($moniker, $class) = each %$moniker_class) {
+ if ( Class::Unload->unload( $class ) ) {
+ my $resultset_class = ref $self->schema->resultset($moniker);
+ Class::Unload->unload( $resultset_class )
+ if $resultset_class ne 'DBIx::Class::ResultSet';
+ }
+ $class->require or die "Can't load $class: $@";
+
+ $self->schema_class->register_class($moniker, $class);
+ $self->schema->register_class($moniker, $class)
+ if $self->schema ne $self->schema_class;
+ }
+}
+
sub _get_dump_filename {
my ($self, $class) = (@_);
@@ -445,16 +453,15 @@
}
sub _dump_to_dir {
- my ($self) = @_;
+ my ($self, @classes) = @_;
my $target_dir = $self->dump_directory;
my $schema_class = $self->schema_class;
- croak "Must specify target directory for dumping!" if ! $target_dir;
+ warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
+ unless $self->{dynamic} or $self->{quiet};
- warn "Dumping manual schema for $schema_class to directory $target_dir ...\n";
-
my $schema_text =
qq|package $schema_class;\n\n|
. qq|use strict;\nuse warnings;\n\n|
@@ -481,7 +488,7 @@
$self->_write_classfile($schema_class, $schema_text);
- foreach my $src_class (sort keys %{$self->{_dump_storage}}) {
+ foreach my $src_class (@classes) {
my $src_text =
qq|package $src_class;\n\n|
. qq|use strict;\nuse warnings;\n\n|
@@ -490,7 +497,9 @@
$self->_write_classfile($src_class, $src_text);
}
- warn "Schema dump completed.\n";
+ warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
+
+ unshift @INC, $target_dir;
}
sub _write_classfile {
@@ -501,7 +510,7 @@
if (-f $filename && $self->really_erase_my_files) {
warn "Deleting existing file '$filename' due to "
- . "'really_erase_my_files' setting\n";
+ . "'really_erase_my_files' setting\n" unless $self->{quiet};
unlink($filename);
}
@@ -571,16 +580,11 @@
sub _use {
my $self = shift;
my $target = shift;
- my $evalstr;
foreach (@_) {
warn "$target: use $_;" if $self->debug;
$self->_raw_stmt($target, "use $_;");
- $_->require or croak ($_ . "->require: $@");
- $evalstr .= "package $target; use $_;";
}
- eval $evalstr if $evalstr;
- croak $@ if $@;
}
sub _inject {
@@ -588,13 +592,9 @@
my $target = shift;
my $schema_class = $self->schema_class;
- my $blist = join(q{ }, map "+$_", @_);
- warn "$target: __PACKAGE__->load_components( qw/ $blist / );" if $self->debug && @_;
- $self->_raw_stmt($target, "__PACKAGE__->load_components( qw/ $blist / );") if @_;
- foreach (@_) {
- $_->require or croak ($_ . "->require: $@");
- $schema_class->inject_base($target, $_);
- }
+ my $blist = join(q{ }, @_);
+ warn "$target: use base qw/ $blist /;" if $self->debug && @_;
+ $self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
}
# Create class with applicable bases, setup monikers, etc
@@ -625,19 +625,17 @@
$self->monikers->{$table} = $table_moniker;
$self->monikers->{$table_normalized} = $table_moniker;
- { no strict 'refs'; @{"${table_class}::ISA"} = qw/DBIx::Class/ }
-
$self->_use ($table_class, @{$self->additional_classes});
- $self->_inject($table_class, @{$self->additional_base_classes});
+ $self->_inject($table_class, @{$self->left_base_classes});
$self->_dbic_stmt($table_class, 'load_components', @{$self->components}, 'Core');
$self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
if @{$self->resultset_components};
- $self->_inject($table_class, @{$self->left_base_classes});
+ $self->_inject($table_class, @{$self->additional_base_classes});
}
-# Set up metadata (cols, pks, etc) and register the class with the schema
+# Set up metadata (cols, pks, etc)
sub _setup_src_meta {
my ($self, $table) = @_;
@@ -676,9 +674,6 @@
my $uniqs = $self->_table_uniq_info($table) || [];
$self->_dbic_stmt($table_class,'add_unique_constraint',@$_) for (@$uniqs);
-
- $schema_class->register_class($table_moniker, $table_class);
- $schema->register_class($table_moniker, $table_class) if $schema ne $schema_class;
}
=head2 tables
@@ -759,30 +754,24 @@
my $class = shift;
my $method = shift;
- if(!$self->debug && !$self->dump_directory) {
- $class->$method(@_);
- return;
- }
-
my $args = dump(@_);
$args = '(' . $args . ')' if @_ < 2;
my $stmt = $method . $args . q{;};
warn qq|$class\->$stmt\n| if $self->debug;
- $class->$method(@_);
$self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
}
# Store a raw source line for a class (for dumping purposes)
sub _raw_stmt {
my ($self, $class, $stmt) = @_;
- push(@{$self->{_dump_storage}->{$class}}, $stmt) if $self->dump_directory;
+ push(@{$self->{_dump_storage}->{$class}}, $stmt);
}
# Like above, but separately for the externally loaded stuff
sub _ext_stmt {
my ($self, $class, $stmt) = @_;
- push(@{$self->{_ext_storage}->{$class}}, $stmt) if $self->dump_directory;
+ push(@{$self->{_ext_storage}->{$class}}, $stmt);
}
=head2 monikers
More information about the Bast-commits
mailing list