From: Rafael Kitover Date: Sun, 29 Nov 2009 18:32:00 +0000 (+0000) Subject: Merge 'current' into 'back-compat' X-Git-Tag: 0.04999_13~23^2~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=09c0a8522aa8dee34ce44704a202c18bc7e8a51e;hp=-c;p=dbsrgits%2FDBIx-Class-Schema-Loader.git Merge 'current' into 'back-compat' r21690@hlagh (orig r7985): caelum | 2009-11-29 09:51:18 -0500 added patch to generate POD from postgres by Andrey Kostenko (GUGU) r21691@hlagh (orig r7986): caelum | 2009-11-29 12:49:40 -0500 fix table count test in common tests, inc version for dev release, add extra tests for table/column comments for Pg, make tests less noisy r21692@hlagh (orig r7987): caelum | 2009-11-29 13:17:04 -0500 new dev release --- 09c0a8522aa8dee34ce44704a202c18bc7e8a51e diff --combined Makefile.PL index 58f13ae,62ffddc..63c3d25 --- a/Makefile.PL +++ b/Makefile.PL @@@ -27,8 -27,6 +27,8 @@@ requires 'Class::Unload' install_script 'script/dbicdump'; +tests_recursive; + # This is my manual hack for better feature control # If you want to change the default answer for a feature, # set the appropriate environment variable, like @@@ -125,10 -123,12 +125,12 @@@ for(my $i = 0; $i <= $#$_features - 1; } # Rebuild README for maintainers - if(-e 'MANIFEST.SKIP') { + if ($Module::Install::AUTHOR) { system("pod2text lib/DBIx/Class/Schema/Loader.pm > README"); } + realclean_files 'README'; + resources 'IRC' => 'irc://irc.perl.org/#dbix-class'; resources 'license' => 'http://dev.perl.org/licenses/'; resources 'repository' => 'http://dev.catalyst.perl.org/repos/bast/branches/DBIx-Class-Schema-Loader/current/'; diff --combined lib/DBIx/Class/Schema/Loader/Base.pm index e1387e9,8d64358..e8ee87b --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@@ -16,7 -16,7 +16,7 @@@ use File::Temp qw// use Class::Unload; require DBIx::Class; - our $VERSION = '0.04999_10'; + our $VERSION = '0.04999_11'; __PACKAGE__->mk_ro_accessors(qw/ schema @@@ -48,13 -48,8 +48,13 @@@ _tables classes monikers + dynamic /); +__PACKAGE__->mk_accessors(qw/ + version_to_dump +/); + =head1 NAME DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation. @@@ -78,55 -73,6 +78,55 @@@ L, 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 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 statement the loader @@@ -326,58 -272,13 +326,58 @@@ sub new $self->{dump_directory} ||= $self->{temp_directory}; - $self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new( - $self->schema, $self->inflect_plural, $self->inflect_singular - ) if !$self->{skip_relationships}; + $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) = @_; @@@ -391,26 -292,14 +391,26 @@@ 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; @@@ -418,6 -307,9 +418,6 @@@ 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, @@@ -437,14 -329,6 +437,14 @@@ ); 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 @@@ -478,7 -362,7 +478,7 @@@ sub rescan my ($self, $schema) = @_; $self->{schema} = $schema; - $self->{relbuilder}{schema} = $schema; + $self->_relbuilder->{schema} = $schema; my @created; my @current = $self->_tables_list; @@@ -493,16 -377,6 +493,16 @@@ 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) = @_; @@@ -527,7 -401,7 +527,7 @@@ # 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; @@@ -538,9 -412,7 +538,9 @@@ $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}; @@@ -549,10 -421,7 +549,10 @@@ } 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; @@@ -574,7 -443,7 +574,7 @@@ 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}) @@@ -582,10 -451,10 +582,10 @@@ && ($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]; } @@@ -596,16 -465,6 +596,16 @@@ } } +# 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) = (@_); @@@ -721,7 -580,7 +721,7 @@@ sub _write_classfile } $text .= $self->_sig_comment( - $DBIx::Class::Schema::Loader::VERSION, + $self->version_to_dump, POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime) ); @@@ -962,7 -821,7 +962,7 @@@ sub _load_relationships 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}; @@@ -996,15 -855,59 +996,59 @@@ sub _dbic_stmt 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) = @_; diff --combined lib/DBIx/Class/Schema/Loader/RelBuilder.pm index a7095c8,46e81ed..0a4f3ed --- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm +++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm @@@ -2,11 -2,10 +2,11 @@@ package DBIx::Class::Schema::Loader::Re use strict; use warnings; +use Class::C3; use Carp::Clan qw/^DBIx::Class/; use Lingua::EN::Inflect::Number (); - our $VERSION = '0.04999_10'; + our $VERSION = '0.04999_11'; =head1 NAME diff --combined t/lib/dbixcsl_common_tests.pm index 509ac66,c7a78de..c15d322 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@@ -73,6 -73,11 +73,11 @@@ sub run_tests $self->drop_tables; } + # defined in sub create + my (@statements, @statements_reltests, @statements_advanced, + @statements_advanced_sqlite, @statements_inline_rels, + @statements_implicit_rels); + sub setup_schema { my $self = shift; my @connect_info = @_; @@@ -115,10 -120,21 +120,21 @@@ my $file_count; find sub { return if -d; $file_count++ }, $DUMP_DIR; - is $file_count, 34, 'correct number of files generated'; - exit if $file_count != 34; + my $expected_count = 34; + + $expected_count += @{ $self->{extra}{drop} || [] }; + + $expected_count -= grep /CREATE TABLE/, @statements_inline_rels + if $self->{no_inline_rels}; + + $expected_count -= grep /CREATE TABLE/, @statements_implicit_rels + if $self->{no_implicit_rels}; + + is $file_count, $expected_count, 'correct number of files generated'; + + exit if $file_count != $expected_count; - my $warn_count = 2; + my $warn_count = 0; $warn_count++ if grep /ResultSetManager/, @loader_warnings; if($self->{skip_rels}) { @@@ -655,7 -671,17 +671,17 @@@ sub test_schema my $before_digest = $digest->digest; my $dbh = $self->dbconnect(1); - $dbh->do($_) for @statements_rescan; + + { + # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." + local $SIG{__WARN__} = sub { + my $msg = shift; + print STDERR $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; + }; + + $dbh->do($_) for @statements_rescan; + } + $dbh->disconnect; sleep 1; @@@ -726,7 -752,7 +752,7 @@@ sub create $self->{_created} = 1; my $make_auto_inc = $self->{auto_inc_cb} || sub {}; - my @statements = ( + @statements = ( qq{ CREATE TABLE loader_test1s ( id $self->{auto_inc_pk}, @@@ -769,7 -795,7 +795,7 @@@ }, ); - my @statements_reltests = ( + @statements_reltests = ( qq{ CREATE TABLE loader_test3 ( id INTEGER NOT NULL PRIMARY KEY, @@@ -1028,7 -1054,7 +1054,7 @@@ q{ INSERT INTO loader_test34 (id,rel1) VALUES (1,2) }, ); - my @statements_advanced = ( + @statements_advanced = ( qq{ CREATE TABLE loader_test10 ( id10 $self->{auto_inc_pk}, @@@ -1053,7 -1079,7 +1079,7 @@@ q{ REFERENCES loader_test11 (id11) }), ); - my @statements_advanced_sqlite = ( + @statements_advanced_sqlite = ( qq{ CREATE TABLE loader_test10 ( id10 $self->{auto_inc_pk}, @@@ -1076,7 -1102,7 +1102,7 @@@ q{ loader_test11 INTEGER REFERENCES loader_test11 (id11) }), ); - my @statements_inline_rels = ( + @statements_inline_rels = ( qq{ CREATE TABLE loader_test12 ( id INTEGER NOT NULL PRIMARY KEY, @@@ -1100,7 -1126,7 +1126,7 @@@ ); - my @statements_implicit_rels = ( + @statements_implicit_rels = ( qq{ CREATE TABLE loader_test14 ( id INTEGER NOT NULL PRIMARY KEY,