From: Rafael Kitover Date: Mon, 5 Jul 2010 06:35:37 +0000 (-0400) Subject: fix some edge cases for use_moose option, and more tests X-Git-Tag: 0.07001~21 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c9cf9b4def5db80a79facea0eaba6dc32ac1e2c3;p=dbsrgits%2FDBIx-Class-Schema-Loader.git fix some edge cases for use_moose option, and more tests --- diff --git a/Changes b/Changes index 82233bd..528ff59 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,6 @@ Revision history for Perl extension DBIx::Class::Schema::Loader + - added use_moose option - always mark pk columns is_nullable=0 - fix unique constraint names for SQLite (actual names break ->deploy) - fix bug in qualify_objects that would add schema to relnames diff --git a/lib/DBIx/Class/Schema/Loader.pm b/lib/DBIx/Class/Schema/Loader.pm index 70e4617..54126ac 100644 --- a/lib/DBIx/Class/Schema/Loader.pm +++ b/lib/DBIx/Class/Schema/Loader.pm @@ -516,6 +516,8 @@ schwern: Michael G. Schwern hobbs: Andrew Rodland +domm: Thomas Klausner + ... and lots of other folks. If we forgot you, please write the current maintainer or RT. diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index fe38170..e8a5ac7 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -201,10 +201,10 @@ 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 +Or if you prefer to use 0.07XXX features but insure that nothing breaks in the next major version upgrade: - __PACKAGE__->naming('v5'); + __PACKAGE__->naming('v7'); =head2 generate_pod @@ -535,6 +535,19 @@ sub new { $self->_validate_class_args; + if ($self->use_moose) { + eval <<'EOF'; +package __DBICSL__DUMMY; +use Moose; +use MooseX::NonMoose; +use namespace::autoclean; +EOF + if ($@) { + die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n", + "Moose, MooseX::NonMoose and namespace::autoclean"; + } + } + push(@{$self->{components}}, 'ResultSetManager') if @{$self->{resultset_components}}; @@ -1087,6 +1100,9 @@ sub _reload_classes { local *Class::C3::reinitialize = sub {}; use warnings; + if ($class->can('meta')) { + $class->meta->make_mutable; + } Class::Unload->unload($class) if $unload; my ($source, $resultset_class); if ( @@ -1095,6 +1111,9 @@ sub _reload_classes { && ($resultset_class ne 'DBIx::Class::ResultSet') ) { my $has_file = Class::Inspector->loaded_filename($resultset_class); + if ($resultset_class->can('meta')) { + $resultset_class->meta->make_mutable; + } Class::Unload->unload($resultset_class) if $unload; $self->_reload_class($resultset_class) if $has_file; } @@ -1124,6 +1143,7 @@ sub _reload_class { unless $_[0] =~ /^Subroutine \S+ redefined/; }; eval "require $class;"; + die "Failed to reload class $class: $@" if $@; } sub _get_dump_filename { @@ -1166,7 +1186,7 @@ sub _dump_to_dir { . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n| . qq|use strict;\nuse warnings;\n\n|; if ($self->use_moose) { - $schema_text.= qq|use Moose;\nuse MooseX::NonMoose;\nextends '$schema_base_class';\n\n|; + $schema_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|; } else { $schema_text .= qq|use base '$schema_base_class';\n\n|; @@ -1206,7 +1226,7 @@ sub _dump_to_dir { . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n| . qq|use strict;\nuse warnings;\n\n|; if ($self->use_moose) { - $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nextends '$result_base_class';\n\n|; + $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends '$result_base_class';\n\n|; } else { $src_text .= qq|use base '$result_base_class';\n\n|; @@ -1257,6 +1277,25 @@ sub _write_classfile { my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename); + # If upgrading to use_moose=1 replace default custom content with default Moose custom content. + # If there is already custom content, which does not have the Moose content, add it. + if ($self->use_moose) { + local $self->{use_moose} = 0; + + if ($custom_content eq $self->_default_custom_content) { + local $self->{use_moose} = 1; + + $custom_content = $self->_default_custom_content; + } + else { + local $self->{use_moose} = 1; + + if ($custom_content !~ /\Q@{[$self->_default_moose_custom_content]}\E/) { + $custom_content .= $self->_default_custom_content; + } + } + } + if (my $old_class = $self->_upgrading_classes->{$class}) { my $old_filename = $self->_get_dump_filename($old_class); @@ -1313,12 +1352,16 @@ sub _write_classfile { or croak "Error closing '$filename': $!"; } +sub _default_moose_custom_content { + return qq|\n__PACKAGE__->meta->make_immutable;|; +} + sub _default_custom_content { my $self = shift; my $default = qq|\n\n# You can replace this text with custom| . qq| content, and it will be preserved on regeneration|; if ($self->use_moose) { - $default .= qq|\nno Moose;\n__PACKAGE__->meta->make_immutable( inline_constructor => 0 );\n1;\n|; + $default .= $self->_default_moose_custom_content; } $default .= qq|\n1;\n|; return $default; diff --git a/t/23dumpmore.t b/t/23dumpmore.t index ea5fd6b..f824cd9 100644 --- a/t/23dumpmore.t +++ b/t/23dumpmore.t @@ -89,7 +89,12 @@ sub get_dsn { sub check_error { my ($got, $expected) = @_; - return unless $got && $expected; + return unless $got; + + if (not $expected) { + fail "Unexpected error in " . ((caller(1))[3]) . ": $got"; + return; + } if (ref $expected eq 'Regexp') { like $got, $expected, 'error matches expected pattern'; @@ -147,8 +152,7 @@ sub dump_file_like { open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; my $contents = do { local $/; <$dumpfh>; }; close($dumpfh); - my $num = 1; - like($contents, $_, "like $path " . $num++) for @_; + like($contents, $_, "$path matches $_") for @_; } sub dump_file_not_like { @@ -156,8 +160,7 @@ sub dump_file_not_like { open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; my $contents = do { local $/; <$dumpfh>; }; close($dumpfh); - my $num = 1; - unlike($contents, $_, "unlike $path ". $num++) for @_; + unlike($contents, $_, "$path does not match $_") for @_; } sub append_to_class { @@ -229,6 +232,166 @@ unlink $config_file; rmtree($DUMP_PATH, 1, 1); +eval "use Moose; use MooseX::NonMoose; use namespace::autoclean;"; +if (not $@) { + +# first dump a fresh use_moose=1 schema + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + use_moose => 1, + result_base_class => 'My::ResultBaseClass', + schema_base_class => 'My::SchemaBaseClass', + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ +qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/, +qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/, + ], + Foo => [ +qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/, +qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/, + ], + Bar => [ +qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/, +qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/, + ], + }, +); + +# now upgrade a non-moose schema to use_moose=1 + +rmtree($DUMP_PATH, 1, 1); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + result_base_class => 'My::ResultBaseClass', + schema_base_class => 'My::SchemaBaseClass', + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/\nuse base 'My::SchemaBaseClass';\n/, + ], + Foo => [ + qr/\nuse base 'My::ResultBaseClass';\n/, + ], + Bar => [ + qr/\nuse base 'My::ResultBaseClass';\n/, + ], + }, +); + +# check that changed custom content is upgraded for Moose bits +append_to_class('DBICTest::DumpMore::1::Foo', q{# XXX This is my custom content XXX}); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + use_moose => 1, + result_base_class => 'My::ResultBaseClass', + schema_base_class => 'My::SchemaBaseClass', + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ +qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/, +qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/, + ], + Foo => [ +qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/, +qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/, + ], + Bar => [ +qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/, +qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/, + ], + }, +); + +# now add the Moose custom content to unapgraded schema, and make sure it is not repeated + +rmtree($DUMP_PATH, 1, 1); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + result_base_class => 'My::ResultBaseClass', + schema_base_class => 'My::SchemaBaseClass', + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/\nuse base 'My::SchemaBaseClass';\n/, + ], + Foo => [ + qr/\nuse base 'My::ResultBaseClass';\n/, + ], + Bar => [ + qr/\nuse base 'My::ResultBaseClass';\n/, + ], + }, +); + +# add Moose custom content then check it is not repeated + +append_to_class('DBICTest::DumpMore::1::Foo', qq{__PACKAGE__->meta->make_immutable;\n1;\n}); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + use_moose => 1, + result_base_class => 'My::ResultBaseClass', + schema_base_class => 'My::SchemaBaseClass', + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ +qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/, +qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/, + ], + Foo => [ +qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/, +qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/, + ], + Bar => [ +qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/, +qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/, + ], + }, + neg_regexes => { + Foo => [ +qr/\n__PACKAGE__->meta->make_immutable;\n.*\n__PACKAGE__->meta->make_immutable;/s, + ], + }, +); + + +} +else { + SKIP: { skip 'use_moose=1 deps not installed', 1 }; +} + +rmtree($DUMP_PATH, 1, 1); + do_dump_test( classname => 'DBICTest::Schema::14', test_db_class => 'make_dbictest_db_clashing_monikers', @@ -260,7 +423,7 @@ do_dump_test( qr/package DBICTest::DumpMore::1::Foo;/, qr/=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/, qr/=head1 ACCESSORS\n\n/, -qr/=head2 fooid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 1\n\n/, +qr/=head2 fooid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 0\n\n/, qr/=head2 footext\n\n data_type: 'text'\n default_value: 'footext'\n extra: {is_footext => 1}\n is_nullable: 1\n\n/, qr/->set_primary_key/, qr/=head1 RELATIONS\n\n/, @@ -271,7 +434,7 @@ qr/1;\n$/, qr/package DBICTest::DumpMore::1::Bar;/, qr/=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/, qr/=head1 ACCESSORS\n\n/, -qr/=head2 barid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 1\n\n/, +qr/=head2 barid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 0\n\n/, qr/=head2 fooref\n\n data_type: 'integer'\n is_foreign_key: 1\n is_nullable: 1\n\n/, qr/->set_primary_key/, qr/=head1 RELATIONS\n\n/,