[Bast-commits] r3162 - in branches/DBIx-Class-Schema-Loader/oracle:
. lib/DBIx/Class/Schema lib/DBIx/Class/Schema/Loader
lib/DBIx/Class/Schema/Loader/DBI t
blblack at dev.catalyst.perl.org
blblack at dev.catalyst.perl.org
Fri Mar 30 23:19:22 GMT 2007
Author: blblack
Date: 2007-03-30 23:19:20 +0100 (Fri, 30 Mar 2007)
New Revision: 3162
Modified:
branches/DBIx-Class-Schema-Loader/oracle/
branches/DBIx-Class-Schema-Loader/oracle/Build.PL
branches/DBIx-Class-Schema-Loader/oracle/Changes
branches/DBIx-Class-Schema-Loader/oracle/TODO
branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader.pm
branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/Base.pm
branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/DBI.pm
branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
branches/DBIx-Class-Schema-Loader/oracle/t/22dump.t
Log:
r27323 at brandon-blacks-computer (orig r3152): blblack | 2007-03-29 09:11:00 -0500
import latest changes to DBIC::Storage::DBI to-be-deprecated columns_info_for to our variant
r27325 at brandon-blacks-computer (orig r3154): blblack | 2007-03-29 17:20:10 -0500
statistics_info support
r27326 at brandon-blacks-computer (orig r3155): blblack | 2007-03-29 19:53:01 -0500
preserve local changes to generated files by default (still needs tests)
r27327 at brandon-blacks-computer (orig r3156): blblack | 2007-03-29 20:11:31 -0500
oops, did not want to commit that comment-out
r27328 at brandon-blacks-computer (orig r3157): blblack | 2007-03-30 00:25:14 -0500
dtrt when previous dumpfile was not generated by us
r27329 at brandon-blacks-computer (orig r3158): blblack | 2007-03-30 01:09:38 -0500
refactor load_external, mainly to prevent requiring files out of the dump directory
r27330 at brandon-blacks-computer (orig r3159): blblack | 2007-03-30 10:42:17 -0500
refactoring top-level loading code with an eye towards the ability to add new tables at runtime
r27331 at brandon-blacks-computer (orig r3160): blblack | 2007-03-30 16:44:30 -0500
refactor relationship building code for runtime table adds as well
r27332 at brandon-blacks-computer (orig r3161): blblack | 2007-03-30 17:17:33 -0500
added rescan method to pick up newly created tables at runtime
Property changes on: branches/DBIx-Class-Schema-Loader/oracle
___________________________________________________________________
Name: svk:merge
- bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/current:3149
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class-Schema-Loader:3147
+ bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/current:3161
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class-Schema-Loader:3147
Modified: branches/DBIx-Class-Schema-Loader/oracle/Build.PL
===================================================================
--- branches/DBIx-Class-Schema-Loader/oracle/Build.PL 2007-03-30 22:17:33 UTC (rev 3161)
+++ branches/DBIx-Class-Schema-Loader/oracle/Build.PL 2007-03-30 22:19:20 UTC (rev 3162)
@@ -11,6 +11,7 @@
'UNIVERSAL::require' => 0.10,
'Lingua::EN::Inflect::Number' => 1.1,
'Text::Balanced' => 0,
+ 'Digest::MD5' => 2.36,
'Class::Accessor' => 0.27,
'Class::Data::Accessor' => 0.02,
'Class::C3' => 0.11,
Modified: branches/DBIx-Class-Schema-Loader/oracle/Changes
===================================================================
--- branches/DBIx-Class-Schema-Loader/oracle/Changes 2007-03-30 22:17:33 UTC (rev 3161)
+++ branches/DBIx-Class-Schema-Loader/oracle/Changes 2007-03-30 22:19:20 UTC (rev 3162)
@@ -1,5 +1,10 @@
Revision history for Perl extension DBIx::Class::Schema::Loader
+ - Made dump_to_dir / dump_overwrite much more intelligent
+ (they now preserve customizations by default)
+ - Added support for DBI's new standard "statistics_info"
+ method to gather unique key info (only supported by
+ DBD::Pg trunk + DBI >= 1.52 so far)
- columns_info_for imported from DBIx::Class
- relationships are now on by default, use skip_relationships
to disable them
Modified: branches/DBIx-Class-Schema-Loader/oracle/TODO
===================================================================
--- branches/DBIx-Class-Schema-Loader/oracle/TODO 2007-03-30 22:17:33 UTC (rev 3161)
+++ branches/DBIx-Class-Schema-Loader/oracle/TODO 2007-03-30 22:19:20 UTC (rev 3162)
@@ -1,13 +1,4 @@
-immediate stuff for 0.04:
---------------------------
-
-dump_to_dir needs to delimit its output so that it can update on overwrite without killing added things
-
-avinash240 wants a rescan method to pick up new tables at runtime
-
--------
-
support multiple/all schemas, instead of just one
support pk/uk/fk info on views, possibly. May or may not be a sane thing to try to do.
Modified: branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/Base.pm 2007-03-30 22:17:33 UTC (rev 3161)
+++ branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/Base.pm 2007-03-30 22:19:20 UTC (rev 3162)
@@ -10,6 +10,8 @@
use Data::Dump qw/ dump /;
use POSIX qw//;
use File::Spec qw//;
+use Cwd qw//;
+use Digest::MD5 qw//;
require DBIx::Class;
our $VERSION = '0.03999_01';
@@ -150,11 +152,7 @@
The created schema class will have the same classname as the one on
which you are setting this option (and the ResultSource classes will be
-based on this name as well). Therefore it is wise to note that if you
-point the C<dump_directory> option of a schema class at the live libdir
-where that class is currently located, it will overwrite itself with a
-manual version of itself. This might be a really good or bad thing
-depending on your situation and perspective.
+based on this name as well).
Normally you wouldn't hard-code this setting in your schema class, as it
is meant for one-time manual usage.
@@ -164,10 +162,19 @@
=head2 dump_overwrite
-If set to a true value, the dumping code will overwrite existing files.
-The default is false, which means the dumping code will skip the already
-existing files.
+Default false. If true, Loader will unconditionally delete any existing
+files before creating the new ones from scratch when dumping a schema to disk.
+The default behavior is instead to only replace the top portion of the
+file, up to and including the final stanza which contains
+C<# DO NOT MODIFY THIS OR ANYTHING ABOVE!>
+leaving any customizations you placed after that as they were.
+
+When C<dump_overwrite> is not set, if the output file already exists,
+but the aforementioned final stanza is not found, or the checksum
+contained there does not match the generated contents, Loader will
+croak and not touch the file.
+
=head1 METHODS
None of these methods are intended for direct invocation by regular
@@ -219,54 +226,77 @@
$self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
$self->{schema} ||= $self->{schema_class};
+ $self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new(
+ $self->schema_class, $self->inflect_plural, $self->inflect_singular
+ ) if !$self->{skip_relationships};
+
$self;
}
+sub _find_file_in_inc {
+ my ($self, $file) = @_;
+
+ foreach my $prefix (@INC) {
+ my $fullpath = $prefix . '/' . $file;
+ return $fullpath if -f $fullpath;
+ }
+
+ return;
+}
+
sub _load_external {
- my $self = shift;
+ my ($self, $class) = @_;
- my $abs_dump_dir;
+ my $class_path = $class;
+ $class_path =~ s{::}{/}g;
+ $class_path .= '.pm';
- $abs_dump_dir = File::Spec->rel2abs($self->dump_directory)
- if $self->dump_directory;
+ my $inc_path = $self->_find_file_in_inc($class_path);
- foreach my $table_class (values %{$self->classes}) {
- $table_class->require;
- if($@ && $@ !~ /^Can't locate /) {
- croak "Failed to load external class definition"
- . " for '$table_class': $@";
- }
- next if $@; # "Can't locate" error
+ return if !$inc_path;
- # If we make it to here, we loaded an external definition
- warn qq/# Loaded external class definition for '$table_class'\n/
- if $self->debug;
+ 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;
- if($abs_dump_dir) {
- my $class_path = $table_class;
- $class_path =~ s{::}{/}g;
- $class_path .= '.pm';
- my $filename = File::Spec->rel2abs($INC{$class_path});
- croak 'Failed to locate actual external module file for '
- . "'$table_class'"
- if !$filename;
- next if($filename =~ /^$abs_dump_dir/);
- open(my $fh, '<', $filename)
- or croak "Failed to open $filename for reading: $!";
- $self->_raw_stmt($table_class,
- q|# These lines loaded from user-supplied external file: |
- );
- while(<$fh>) {
- chomp;
- $self->_raw_stmt($table_class, $_);
- }
- $self->_raw_stmt($table_class,
- q|# End of lines loaded from user-supplied external file |
- );
- close($fh)
- or croak "Failed to close $filename: $!";
- }
+ $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;
+
+ # 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;
+ open(my $fh, '<', $real_inc_path)
+ or croak "Failed to open '$real_inc_path' for reading: $!";
+ $self->_ext_stmt($class,
+ qq|# These lines were loaded from '$real_inc_path' found in \@INC.|
+ .q|# They are now part of the custom portion of this file|
+ .q|# for you to hand-edit. If you do not either delete|
+ .q|# this section or remove that file from @INC, this section|
+ .q|# will be repeated redundantly when you re-create this|
+ .q|# file again via Loader!|
+ );
+ while(<$fh>) {
+ chomp;
+ $self->_ext_stmt($class, $_);
}
+ $self->_ext_stmt($class,
+ q|# End of lines loaded from '$real_inc_path' |
+ );
+ close($fh)
+ or croak "Failed to close $real_inc_path: $!";
}
=head2 load
@@ -278,9 +308,65 @@
sub load {
my $self = shift;
- $self->_load_classes;
- $self->_load_relationships if ! $self->skip_relationships;
- $self->_load_external;
+ $self->_load_tables($self->_tables_list);
+}
+
+=head2 rescan
+
+Rescan the database for newly added tables. Does
+not process drops or changes.
+
+=cut
+
+sub rescan {
+ my $self = shift;
+
+ my @created;
+ my @current = $self->_tables_list;
+ foreach my $table ($self->_tables_list) {
+ if(!exists $self->{_tables}->{$table}) {
+ push(@created, $table);
+ }
+ }
+
+ $self->_load_tables(@created);
+}
+
+sub _load_tables {
+ my ($self, @tables) = @_;
+
+ # First, use _tables_list with constraint and exclude
+ # to get a list of tables to operate on
+
+ my $constraint = $self->constraint;
+ my $exclude = $self->exclude;
+
+ @tables = grep { /$constraint/ } @tables if $constraint;
+ @tables = grep { ! /$exclude/ } @tables if $exclude;
+
+ # Save the new tables to the tables list
+ push(@{$self->{_tables}}, @tables);
+
+ # Set up classes/monikers
+ {
+ no warnings 'redefine';
+ local *Class::C3::reinitialize = sub { };
+ use warnings;
+
+ $self->_make_src_class($_) for @tables;
+ }
+
+ Class::C3::reinitialize;
+
+ $self->_setup_src_meta($_) for @tables;
+
+ if(!$self->skip_relationships) {
+ $self->_load_relationships($_) for @tables;
+ }
+
+ $self->_load_external($_)
+ for ($self->schema_class, values %{$self->classes});
+
$self->_dump_to_dir if $self->dump_directory;
# Drop temporary cache
@@ -304,11 +390,12 @@
# which is a filename
my $dir = $self->dump_directory;
- foreach (@name_parts) {
- $dir = File::Spec->catdir($dir,$_);
- if(! -d $dir) {
+ while (1) {
+ if(!-d $dir) {
mkdir($dir) or croak "mkdir('$dir') failed: $!";
}
+ last if !@name_parts;
+ $dir = File::Spec->catdir($dir, shift @name_parts);
}
}
@@ -323,52 +410,99 @@
warn "Dumping manual schema for $schema_class to directory $target_dir ...\n";
- if(! -d $target_dir) {
- mkdir($target_dir) or croak "mkdir('$target_dir') failed: $!";
- }
+ my $schema_text =
+ qq|package $schema_class;\n\n|
+ . qq|use strict;\nuse warnings;\n\n|
+ . qq|use base 'DBIx::Class::Schema';\n\n|
+ . qq|__PACKAGE__->load_classes;\n|;
- my $verstr = $DBIx::Class::Schema::Loader::VERSION;
- my $datestr = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime);
- my $tagline = qq|# Created by DBIx::Class::Schema::Loader v$verstr @ $datestr|;
+ $self->_write_classfile($schema_class, $schema_text);
- $self->_ensure_dump_subdirs($schema_class);
+ foreach my $src_class (sort keys %{$self->{_dump_storage}}) {
+ my $src_text =
+ qq|package $src_class;\n\n|
+ . qq|use strict;\nuse warnings;\n\n|
+ . qq|use base 'DBIx::Class';\n\n|;
- my $schema_fn = $self->_get_dump_filename($schema_class);
- if (-f $schema_fn && !$self->dump_overwrite) {
- warn "$schema_fn exists, will not overwrite\n";
+ $self->_write_classfile($src_class, $src_text);
}
- else {
- open(my $schema_fh, '>', $schema_fn)
- or croak "Cannot open $schema_fn for writing: $!";
- print $schema_fh qq|package $schema_class;\n\n$tagline\n\n|;
- print $schema_fh qq|use strict;\nuse warnings;\n\n|;
- print $schema_fh qq|use base 'DBIx::Class::Schema';\n\n|;
- print $schema_fh qq|__PACKAGE__->load_classes;\n|;
- print $schema_fh qq|\n1;\n\n|;
- close($schema_fh)
- or croak "Cannot close $schema_fn: $!";
- }
- foreach my $src_class (sort keys %{$self->{_dump_storage}}) {
- $self->_ensure_dump_subdirs($src_class);
- my $src_fn = $self->_get_dump_filename($src_class);
- if (-f $src_fn && !$self->dump_overwrite) {
- warn "$src_fn exists, will not overwrite\n";
- next;
- }
- open(my $src_fh, '>', $src_fn)
- or croak "Cannot open $src_fn for writing: $!";
- print $src_fh qq|package $src_class;\n\n$tagline\n\n|;
- print $src_fh qq|use strict;\nuse warnings;\n\n|;
- print $src_fh qq|use base 'DBIx::Class';\n\n|;
- print $src_fh qq|$_\n|
- for @{$self->{_dump_storage}->{$src_class}};
- print $src_fh qq|\n1;\n\n|;
- close($src_fh)
- or croak "Cannot close $src_fn: $!";
+ warn "Schema dump completed.\n";
+}
+
+sub _write_classfile {
+ my ($self, $class, $text) = @_;
+
+ my $filename = $self->_get_dump_filename($class);
+ $self->_ensure_dump_subdirs($class);
+
+ if (-f $filename && $self->dump_overwrite) {
+ warn "Deleting existing file '$filename' due to "
+ . "'dump_overwrite' setting\n";
+ unlink($filename);
+ }
+
+ my $custom_content = $self->_get_custom_content($class, $filename);
+
+ $custom_content ||= qq|\n# You can replace this text with custom|
+ . qq| content, and it will be preserved on regeneration|
+ . qq|\n1;\n|;
+
+ $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:|;
+
+ open(my $fh, '>', $filename)
+ or croak "Cannot open '$filename' for writing: $!";
+
+ # Write the top half and its MD5 sum
+ print $fh $text . Digest::MD5::md5_base64($text) . "\n\n";
+
+ # Write out anything loaded via external partial class file in @INC
+ print $fh qq|$_\n|
+ for @{$self->{_ext_storage}->{$class} || []};
+
+ print $fh $custom_content;
+
+ close($fh)
+ or croak "Cannot close '$filename': $!";
+}
+
+sub _get_custom_content {
+ my ($self, $class, $filename) = @_;
+
+ return 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 = '';
+ while(<$fh>) {
+ if(!$found && /$mark_re/) {
+ $found = 1;
+ $buffer .= $1;
+ croak "Checksum mismatch in '$filename'"
+ if Digest::MD5::md5_base64($buffer) ne $2;
+
+ $buffer = '';
+ }
+ else {
+ $buffer .= $_;
+ }
}
- warn "Schema dump completed.\n";
+ croak "Cannot not overwrite '$filename' without 'dump_overwrite',"
+ . " it does not appear to have been generated by Loader"
+ if !$found;
+
+ return $buffer;
}
sub _use {
@@ -400,87 +534,70 @@
}
}
-# Load and setup classes
-sub _load_classes {
- my $self = shift;
+# Create class with applicable bases, setup monikers, etc
+sub _make_src_class {
+ my ($self, $table) = @_;
my $schema = $self->schema;
my $schema_class = $self->schema_class;
- my $constraint = $self->constraint;
- my $exclude = $self->exclude;
- my @tables = sort $self->_tables_list;
- warn "No tables found in database, nothing to load" if !@tables;
+ my $table_moniker = $self->_table2moniker($table);
+ my $table_class = $schema_class . q{::} . $table_moniker;
- if(@tables) {
- @tables = grep { /$constraint/ } @tables if $constraint;
- @tables = grep { ! /$exclude/ } @tables if $exclude;
+ my $table_normalized = lc $table;
+ $self->classes->{$table} = $table_class;
+ $self->classes->{$table_normalized} = $table_class;
+ $self->monikers->{$table} = $table_moniker;
+ $self->monikers->{$table_normalized} = $table_moniker;
- warn "All tables excluded by constraint/exclude, nothing to load"
- if !@tables;
- }
+ { no strict 'refs'; @{"${table_class}::ISA"} = qw/DBIx::Class/ }
- $self->{_tables} = \@tables;
+ $self->_use ($table_class, @{$self->additional_classes});
+ $self->_inject($table_class, @{$self->additional_base_classes});
- foreach my $table (@tables) {
- my $table_moniker = $self->_table2moniker($table);
- my $table_class = $schema_class . q{::} . $table_moniker;
+ $self->_dbic_stmt($table_class, 'load_components', @{$self->components}, qw/PK::Auto Core/);
- my $table_normalized = lc $table;
- $self->classes->{$table} = $table_class;
- $self->classes->{$table_normalized} = $table_class;
- $self->monikers->{$table} = $table_moniker;
- $self->monikers->{$table_normalized} = $table_moniker;
+ $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
+ if @{$self->resultset_components};
+ $self->_inject($table_class, @{$self->left_base_classes});
+}
- no warnings 'redefine';
- local *Class::C3::reinitialize = sub { };
- use warnings;
+# Set up metadata (cols, pks, etc) and register the class with the schema
+sub _setup_src_meta {
+ my ($self, $table) = @_;
- { no strict 'refs'; @{"${table_class}::ISA"} = qw/DBIx::Class/ }
+ my $schema = $self->schema;
+ my $schema_class = $self->schema_class;
- $self->_use ($table_class, @{$self->additional_classes});
- $self->_inject($table_class, @{$self->additional_base_classes});
+ my $table_class = $self->classes->{$table};
+ my $table_moniker = $self->monikers->{$table};
- $self->_dbic_stmt($table_class, 'load_components', @{$self->components}, qw/PK::Auto Core/);
+ $self->_dbic_stmt($table_class,'table',$table);
- $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
- if @{$self->resultset_components};
- $self->_inject($table_class, @{$self->left_base_classes});
+ my $cols = $self->_table_columns($table);
+ my $col_info;
+ eval { $col_info = $self->_columns_info_for($table) };
+ if($@) {
+ $self->_dbic_stmt($table_class,'add_columns',@$cols);
}
+ else {
+ my %col_info_lc = map { lc($_), $col_info->{$_} } keys %$col_info;
+ $self->_dbic_stmt(
+ $table_class,
+ 'add_columns',
+ map { $_, ($col_info_lc{$_}||{}) } @$cols
+ );
+ }
- Class::C3::reinitialize;
+ my $pks = $self->_table_pk_info($table) || [];
+ @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
+ : carp("$table has no primary key");
- foreach my $table (@tables) {
- my $table_class = $self->classes->{$table};
- my $table_moniker = $self->monikers->{$table};
+ my $uniqs = $self->_table_uniq_info($table) || [];
+ $self->_dbic_stmt($table_class,'add_unique_constraint',@$_) for (@$uniqs);
- $self->_dbic_stmt($table_class,'table',$table);
-
- my $cols = $self->_table_columns($table);
- my $col_info;
- eval { $col_info = $self->_columns_info_for($table) };
- if($@) {
- $self->_dbic_stmt($table_class,'add_columns',@$cols);
- }
- else {
- my %col_info_lc = map { lc($_), $col_info->{$_} } keys %$col_info;
- $self->_dbic_stmt(
- $table_class,
- 'add_columns',
- map { $_, ($col_info_lc{$_}||{}) } @$cols
- );
- }
-
- my $pks = $self->_table_pk_info($table) || [];
- @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
- : carp("$table has no primary key");
-
- 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;
- }
+ $schema_class->register_class($table_moniker, $table_class);
+ $schema->register_class($table_moniker, $table_class) if $schema ne $schema_class;
}
=head2 tables
@@ -493,7 +610,7 @@
sub tables {
my $self = shift;
- return @{$self->_tables};
+ return keys %{$self->_tables};
}
# Make a moniker from a table
@@ -515,27 +632,17 @@
}
sub _load_relationships {
- my $self = shift;
+ my ($self, $table) = @_;
- # Construct the fk_info RelBuilder wants to see, by
- # translating table names to monikers in the _fk_info output
- my %fk_info;
- foreach my $table ($self->tables) {
- my $tbl_fk_info = $self->_table_fk_info($table);
- foreach my $fkdef (@$tbl_fk_info) {
- $fkdef->{remote_source} =
- $self->monikers->{delete $fkdef->{remote_table}};
- }
- my $moniker = $self->monikers->{$table};
- $fk_info{$moniker} = $tbl_fk_info;
+ my $tbl_fk_info = $self->_table_fk_info($table);
+ foreach my $fkdef (@$tbl_fk_info) {
+ $fkdef->{remote_source} =
+ $self->monikers->{delete $fkdef->{remote_table}};
}
- my $relbuilder = DBIx::Class::Schema::Loader::RelBuilder->new(
- $self->schema_class, \%fk_info, $self->inflect_plural,
- $self->inflect_singular
- );
+ my $local_moniker = $self->monikers->{$table};
+ my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info);
- my $rel_stmts = $relbuilder->generate_code;
foreach my $src_class (sort keys %$rel_stmts) {
my $src_stmts = $rel_stmts->{$src_class};
foreach my $stmt (@$src_stmts) {
@@ -589,6 +696,12 @@
push(@{$self->{_dump_storage}->{$class}}, $stmt) if $self->dump_directory;
}
+# 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;
+}
+
=head2 monikers
Returns a hashref of loaded table to moniker mappings. There will
Modified: branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm 2007-03-30 22:17:33 UTC (rev 3161)
+++ branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm 2007-03-30 22:19:20 UTC (rev 3162)
@@ -38,6 +38,11 @@
sub _table_uniq_info {
my ($self, $table) = @_;
+ # Use the default support if available
+ return $self->next::method($table)
+ if $DBI::VERSION >= 1.52
+ && $DBD::Pg::VERSION >= 1.50;
+
my @uniqs;
my $dbh = $self->schema->storage->dbh;
Modified: branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/DBI.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/DBI.pm 2007-03-30 22:17:33 UTC (rev 3161)
+++ branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/DBI.pm 2007-03-30 22:19:20 UTC (rev 3162)
@@ -114,7 +114,7 @@
# Returns arrayref of pk col names
sub _table_pk_info {
- my ( $self, $table ) = @_;
+ my ($self, $table) = @_;
my $dbh = $self->schema->storage->dbh;
@@ -124,10 +124,40 @@
return \@primary;
}
-# Override this for uniq info
+# Override this for vendor-specific uniq info
sub _table_uniq_info {
- warn "No UNIQUE constraint information can be gathered for this vendor";
- return [];
+ my ($self, $table) = @_;
+
+ my $dbh = $self->schema->storage->dbh;
+ if(!$dbh->can('statistics_info')) {
+ warn "No UNIQUE constraint information can be gathered for this vendor";
+ return [];
+ }
+
+ my %indices;
+ my $sth = $dbh->statistics_info(undef, $self->db_schema, $table, 1, 1);
+ while(my $row = $sth->fetchrow_hashref) {
+ # skip table-level stats, conditional indexes, and any index missing
+ # critical fields
+ next if $row->{TYPE} eq 'table'
+ || defined $row->{FILTER_CONDITION}
+ || !$row->{INDEX_NAME}
+ || !defined $row->{ORDINAL_POSITION}
+ || !$row->{COLUMN_NAME};
+
+ $indices{$row->{INDEX_NAME}}->{$row->{ORDINAL_POSITION}} = $row->{COLUMN_NAME};
+ }
+
+ my @retval;
+ foreach my $index_name (keys %indices) {
+ my $index = $indices{$index_name};
+ push(@retval, [ $index_name => [
+ map { $index->{$_} }
+ sort keys %$index
+ ]]);
+ }
+
+ return \@retval;
}
# Find relationships
@@ -197,18 +227,12 @@
$table = $self->db_schema . $self->{_namesep} . $table;
}
my %result;
- my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0");
+ my $sth = $dbh->prepare($self->schema->storage->sql_maker->select($table, undef, \'1 = 0'));
$sth->execute;
my @columns = @{$sth->{NAME_lc}};
for my $i ( 0 .. $#columns ){
my %column_info;
- my $type_num = $sth->{TYPE}->[$i];
- my $type_name;
- if(defined $type_num && $dbh->can('type_info')) {
- my $type_info = $dbh->type_info($type_num);
- $type_name = $type_info->{TYPE_NAME} if $type_info;
- }
- $column_info{data_type} = $type_name ? $type_name : $type_num;
+ $column_info{data_type} = $sth->{TYPE}->[$i];
$column_info{size} = $sth->{PRECISION}->[$i];
$column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
@@ -219,11 +243,22 @@
$result{$columns[$i]} = \%column_info;
}
+ $sth->finish;
+ foreach my $col (keys %result) {
+ my $colinfo = $result{$col};
+ my $type_num = $colinfo->{data_type};
+ my $type_name;
+ if(defined $type_num && $dbh->can('type_info')) {
+ my $type_info = $dbh->type_info($type_num);
+ $type_name = $type_info->{TYPE_NAME} if $type_info;
+ $colinfo->{data_type} = $type_name if $type_name;
+ }
+ }
+
return \%result;
}
-
=head1 SEE ALSO
L<DBIx::Class::Schema::Loader>
Modified: branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/RelBuilder.pm 2007-03-30 22:17:33 UTC (rev 3161)
+++ branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader/RelBuilder.pm 2007-03-30 22:19:20 UTC (rev 3162)
@@ -24,43 +24,47 @@
=head2 new
-Arguments: schema_class (scalar), fk_info (hashref), inflect_plural, inflect_singular
+Arguments: schema_class (scalar), inflect_plural, inflect_singular
C<$schema_class> should be a schema class name, where the source
classes have already been set up and registered. Column info, primary
key, and unique constraints will be drawn from this schema for all
of the existing source monikers.
-The fk_info hashref's contents should take the form:
-
- {
- TableMoniker => [
- {
- local_columns => [ 'col2', 'col3' ],
- remote_columns => [ 'col5', 'col7' ],
- remote_moniker => 'AnotherTableMoniker',
- },
- # ...
- ],
- AnotherTableMoniker => [
- # ...
- ],
- # ...
- }
-
Options inflect_plural and inflect_singular are optional, and are better documented
in L<DBIx::Class::Schema::Loader::Base>.
=head2 generate_code
-This method will return the generated relationships as a hashref per table moniker,
-containing an arrayref of code strings which can be "eval"-ed in the context of
-the source class, like:
+Arguments: local_moniker (scalar), fk_info (arrayref)
+This generates the code for the relationships of a given table.
+
+C<local_moniker> is the moniker name of the table which had the REFERENCES
+statements. The fk_info arrayref's contents should take the form:
+
+ [
+ {
+ local_columns => [ 'col2', 'col3' ],
+ remote_columns => [ 'col5', 'col7' ],
+ remote_moniker => 'AnotherTableMoniker',
+ },
+ {
+ local_columns => [ 'col1', 'col4' ],
+ remote_columns => [ 'col1', 'col2' ],
+ remote_moniker => 'YetAnotherTableMoniker',
+ },
+ # ...
+ ],
+
+This method will return the generated relationships as a hashref keyed on the
+class names. The values are arrayrefs of hashes containing method name and
+arguments, like so:
+
{
'Some::Source::Class' => [
- "belongs_to( col1 => 'AnotherTableMoniker' )",
- "has_many( anothers => 'AnotherTableMoniker', 'col15' )",
+ { method => 'belongs_to', arguments => [ 'col1', 'Another::Source::Class' ],
+ { method => 'has_many', arguments => [ 'anothers', 'Yet::Another::Source::Class', 'col15' ],
],
'Another::Source::Class' => [
# ...
@@ -68,18 +72,13 @@
# ...
}
-You might want to use this in building an on-disk source class file, by
-adding each string to the appropriate source class file,
-prefixed by C<__PACKAGE__-E<gt>>.
-
=cut
sub new {
- my ( $class, $schema, $fk_info, $inflect_pl, $inflect_singular ) = @_;
+ my ( $class, $schema, $inflect_pl, $inflect_singular ) = @_;
my $self = {
schema => $schema,
- fk_info => $fk_info,
inflect_plural => $inflect_pl,
inflect_singular => $inflect_singular,
};
@@ -123,89 +122,86 @@
}
sub generate_code {
- my $self = shift;
+ my ($self, $local_moniker, $rels) = @_;
my $all_code = {};
- foreach my $local_moniker (keys %{$self->{fk_info}}) {
- my $local_table = $self->{schema}->source($local_moniker)->from;
- my $local_class = $self->{schema}->class($local_moniker);
- my $rels = $self->{fk_info}->{$local_moniker};
+ my $local_table = $self->{schema}->source($local_moniker)->from;
+ my $local_class = $self->{schema}->class($local_moniker);
- my %counters;
- foreach my $rel (@$rels) {
- next if !$rel->{remote_source};
- $counters{$rel->{remote_source}}++;
- }
+ my %counters;
+ foreach my $rel (@$rels) {
+ next if !$rel->{remote_source};
+ $counters{$rel->{remote_source}}++;
+ }
- foreach my $rel (@$rels) {
- next if !$rel->{remote_source};
- my $local_cols = $rel->{local_columns};
- my $remote_cols = $rel->{remote_columns};
- my $remote_moniker = $rel->{remote_source};
- my $remote_obj = $self->{schema}->source($remote_moniker);
- my $remote_class = $self->{schema}->class($remote_moniker);
- my $remote_table = $remote_obj->from;
- $remote_cols ||= [ $remote_obj->primary_columns ];
+ foreach my $rel (@$rels) {
+ next if !$rel->{remote_source};
+ my $local_cols = $rel->{local_columns};
+ my $remote_cols = $rel->{remote_columns};
+ my $remote_moniker = $rel->{remote_source};
+ my $remote_obj = $self->{schema}->source($remote_moniker);
+ my $remote_class = $self->{schema}->class($remote_moniker);
+ my $remote_table = $remote_obj->from;
+ $remote_cols ||= [ $remote_obj->primary_columns ];
- if($#$local_cols != $#$remote_cols) {
- croak "Column count mismatch: $local_moniker (@$local_cols) "
- . "$remote_moniker (@$remote_cols)";
- }
+ if($#$local_cols != $#$remote_cols) {
+ croak "Column count mismatch: $local_moniker (@$local_cols) "
+ . "$remote_moniker (@$remote_cols)";
+ }
- my %cond;
- foreach my $i (0 .. $#$local_cols) {
- $cond{$remote_cols->[$i]} = $local_cols->[$i];
- }
+ my %cond;
+ foreach my $i (0 .. $#$local_cols) {
+ $cond{$remote_cols->[$i]} = $local_cols->[$i];
+ }
- # If more than one rel between this pair of tables, use the
- # local col name(s) as the relname in the foreign source, instead
- # of the local table name.
- my $local_relname;
- if($counters{$remote_moniker} > 1) {
- $local_relname = $self->_inflect_plural(
- lc($local_table) . q{_} . join(q{_}, @$local_cols)
- );
- } else {
- $local_relname = $self->_inflect_plural(lc $local_table);
- }
+ # If more than one rel between this pair of tables, use the
+ # local col name(s) as the relname in the foreign source, instead
+ # of the local table name.
+ my $local_relname;
+ if($counters{$remote_moniker} > 1) {
+ $local_relname = $self->_inflect_plural(
+ lc($local_table) . q{_} . join(q{_}, @$local_cols)
+ );
+ } else {
+ $local_relname = $self->_inflect_plural(lc $local_table);
+ }
- # for single-column case, set the relname to the column name,
- # to make filter accessors work
- my $remote_relname;
- if(scalar keys %cond == 1) {
- my ($col) = keys %cond;
- $remote_relname = $self->_inflect_singular($cond{$col});
- }
- else {
- $remote_relname = $self->_inflect_singular(lc $remote_table);
- }
+ # for single-column case, set the relname to the column name,
+ # to make filter accessors work
+ my $remote_relname;
+ if(scalar keys %cond == 1) {
+ my ($col) = keys %cond;
+ $remote_relname = $self->_inflect_singular($cond{$col});
+ }
+ else {
+ $remote_relname = $self->_inflect_singular(lc $remote_table);
+ }
- my %rev_cond = reverse %cond;
+ my %rev_cond = reverse %cond;
- for (keys %rev_cond) {
- $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
- delete $rev_cond{$_};
+ for (keys %rev_cond) {
+ $rev_cond{"foreign.$_"} = "self.".$rev_cond{$_};
+ delete $rev_cond{$_};
+ }
+
+ push(@{$all_code->{$local_class}},
+ { method => 'belongs_to',
+ args => [ $remote_relname,
+ $remote_class,
+ \%cond,
+ ],
}
+ );
- push(@{$all_code->{$local_class}},
- { method => 'belongs_to',
- args => [ $remote_relname,
- $remote_class,
- \%cond,
- ],
- }
- );
-
- push(@{$all_code->{$remote_class}},
- { method => 'has_many',
- args => [ $local_relname,
- $local_class,
- \%rev_cond,
- ],
- }
- );
- }
+ push(@{$all_code->{$remote_class}},
+ { method => 'has_many',
+ args => [ $local_relname,
+ $local_class,
+ \%rev_cond,
+ ],
+ }
+ );
}
return $all_code;
Modified: branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader.pm 2007-03-30 22:17:33 UTC (rev 3161)
+++ branches/DBIx-Class-Schema-Loader/oracle/lib/DBIx/Class/Schema/Loader.pm 2007-03-30 22:19:20 UTC (rev 3162)
@@ -17,6 +17,7 @@
__PACKAGE__->mk_classaccessor('dump_to_dir');
__PACKAGE__->mk_classaccessor('_loader_args' => {});
__PACKAGE__->mk_classaccessor('_loader_invoked');
+__PACKAGE__->mk_classaccessor('_loader');
=head1 NAME
@@ -111,7 +112,8 @@
croak qq/Could not load storage_type loader "$impl": / .
qq/"$UNIVERSAL::require::ERROR"/;
- $impl->new(%$args)->load;
+ $self->_loader($impl->new(%$args));
+ $self->_loader->load;
$self->_loader_invoked(1);
$self;
@@ -284,6 +286,16 @@
$target->connection(@$connect_info);
}
+=head2 rescan
+
+Re-scans the database for newly added tables since the initial
+load, and adds them to the schema at runtime, including relationships,
+etc. Does not process drops or changes.
+
+=cut
+
+sub rescan { shift->_loader->rescan }
+
=head1 EXAMPLE
Using the example in L<DBIx::Class::Manual::ExampleSchema> as a basis
Modified: branches/DBIx-Class-Schema-Loader/oracle/t/22dump.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/oracle/t/22dump.t 2007-03-30 22:17:33 UTC (rev 3161)
+++ branches/DBIx-Class-Schema-Loader/oracle/t/22dump.t 2007-03-30 22:19:20 UTC (rev 3162)
@@ -25,7 +25,7 @@
);
}
-plan tests => 8;
+plan tests => 5;
rmtree($dump_path, 1, 1);
@@ -45,7 +45,6 @@
}
my @warnings_regexes = (
qr|Dumping manual schema|,
- (qr|DBICTest/Schema/1.*?.pm exists, will not overwrite|) x 3,
qr|Schema dump completed|,
);
More information about the Bast-commits
mailing list