From: Rafael Kitover Date: Sun, 29 May 2011 15:49:47 +0000 (-0400) Subject: support arrayrefs for result_namespace and resultset_namespace (RT#40214) X-Git-Tag: 0.07011~95 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dc96667ab512fd5d1af88bb06d8e89e42c706c02;p=dbsrgits%2FDBIx-Class-Schema-Loader.git support arrayrefs for result_namespace and resultset_namespace (RT#40214) --- diff --git a/Changes b/Changes index 8e3e3ef..9e993cd 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,7 @@ Revision history for Perl extension DBIx::Class::Schema::Loader + - support arrayrefs for result_namespace and resultset_namespace + (RT#40214) - add naming => { monikers => 'preserve' } or 'singular'/'plural' to control moniker inflection (RT#44935) - add naming => { column_accessors => 'preserve' } to not normalize diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 1a62670..6ea127f 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -17,12 +17,12 @@ use File::Temp qw//; use Class::Unload; use Class::Inspector (); use Scalar::Util 'looks_like_number'; -use File::Slurp 'slurp'; +use File::Slurp 'read_file'; use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path/; use DBIx::Class::Schema::Loader::Optional::Dependencies (); use Try::Tiny; use DBIx::Class (); -use Encode qw/decode encode/; +use Encode qw/encode/; use namespace::clean; our $VERSION = '0.07010'; @@ -821,7 +821,7 @@ EOF } # otherwise check if we need backcompat mode for a static schema - my $filename = $self->_get_dump_filename($self->schema_class); + my $filename = $self->get_dump_filename($self->schema_class); return unless -e $filename; my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) = @@ -835,7 +835,14 @@ EOF } my $load_classes = ($old_gen =~ /^__PACKAGE__->load_classes;/m) ? 1 : 0; - my $result_namespace = do { ($old_gen =~ /result_namespace => '([^']+)'/) ? $1 : '' }; + + my $result_namespace = do { ($old_gen =~ /result_namespace => (.+)/) ? $1 : '' }; + my $ds = eval $result_namespace; + die <<"EOF" if $@; +Could not eval expression '$result_namespace' for result_namespace from +$filename: $@ +EOF + $result_namespace = $ds; if ($load_classes && (not defined $self->use_namespaces)) { warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT}; @@ -1023,7 +1030,7 @@ sub _load_external { warn qq/# Loaded external class definition for '$class'\n/ if $self->debug; - my $code = $self->_rewrite_old_classnames(decode 'UTF-8', scalar slurp $real_inc_path); + my $code = $self->_rewrite_old_classnames(scalar read_file($real_inc_path, binmode => ':encoding(UTF-8)')); if ($self->dynamic) { # load the class too eval_package_without_redefine_warnings($class, $code); @@ -1046,7 +1053,7 @@ sub _load_external { } if ($old_real_inc_path) { - my $code = decode 'UTF-8', scalar slurp $old_real_inc_path; + my $code = read_file($old_real_inc_path, binmode => ':encoding(UTF-8)'); $self->_ext_stmt($class, <<"EOF"); @@ -1301,7 +1308,7 @@ sub _reload_class { eval_package_without_redefine_warnings ($class, "require $class"); } catch { - my $source = decode 'UTF-8', scalar slurp $self->_get_dump_filename($class); + my $source = read_file($self->_get_dump_filename($class), binmode => ':encoding(UTF-8)'); die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source"; }; } @@ -1379,7 +1386,8 @@ sub _dump_to_dir { for my $attr (@attr) { if ($self->$attr) { - $namespace_options .= qq| $attr => '| . $self->$attr . qq|',\n| + my $code = dumper_squashed $self->$attr; + $namespace_options .= qq| $attr => $code,\n| } } $schema_text .= qq|(\n$namespace_options)| if $namespace_options; @@ -1652,6 +1660,8 @@ sub _result_namespace { my ($self, $schema_class, $ns) = @_; my @result_namespace; + $ns = $ns->[0] if ref $ns; + if ($ns =~ /^\+(.*)/) { # Fully qualified namespace @result_namespace = ($1) diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm index c58f016..4cfd707 100644 --- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm +++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm @@ -9,12 +9,11 @@ use Scalar::Util 'weaken'; use Lingua::EN::Inflect::Phrase (); use Lingua::EN::Tagger (); use DBIx::Class::Schema::Loader::Utils 'split_name'; -use File::Slurp 'slurp'; +use File::Slurp 'read_file'; use Try::Tiny; use Class::Unload (); use Class::Inspector (); use List::MoreUtils 'apply'; -use Encode 'decode'; use namespace::clean; our $VERSION = '0.07010'; @@ -598,7 +597,7 @@ sub _relnames_and_method { my $class = "${remote_class}Temporary"; if (not Class::Inspector->loaded($class)) { - my $code = decode 'UTF-8', scalar slurp $existing_remote_file; + my $code = read_file($existing_remote_file, binmode => ':encoding(UTF-8)'); $code =~ s/(?<=package $remote_class)/Temporary/g; diff --git a/t/lib/DBIXCSL_Test/Schema/LoaderTest1.pm b/t/lib/DBIXCSL_Test/Schema/LoaderTest1.pm deleted file mode 100644 index b4c3c65..0000000 --- a/t/lib/DBIXCSL_Test/Schema/LoaderTest1.pm +++ /dev/null @@ -1,7 +0,0 @@ -package DBIXCSL_Test::Schema::LoaderTest1; - -sub loader_test1_classmeth { 'all is well' } - -sub loader_test1_rsmeth : ResultSet { 'all is still well' } - -1; diff --git a/t/lib/DBIXCSL_Test/Schema/MyResult/LoaderTest1.pm b/t/lib/DBIXCSL_Test/Schema/MyResult/LoaderTest1.pm new file mode 100644 index 0000000..f80a699 --- /dev/null +++ b/t/lib/DBIXCSL_Test/Schema/MyResult/LoaderTest1.pm @@ -0,0 +1,5 @@ +package DBIXCSL_Test::Schema::MyResult::LoaderTest1; + +sub loader_test1_classmeth { 'all is well' } + +1; diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index dc10b92..e3df577 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -16,19 +16,28 @@ use DBIx::Class::Schema::Loader::Utils 'dumper_squashed'; use List::MoreUtils 'apply'; use DBIx::Class::Schema::Loader::Optional::Dependencies (); use Try::Tiny; -use File::Slurp 'slurp'; +use File::Slurp 'read_file'; +use File::Spec::Functions 'catfile'; +use File::Basename 'basename'; use namespace::clean; use dbixcsl_test_dir qw/$tdir/; -my $DUMP_DIR = "$tdir/common_dump"; -rmtree $DUMP_DIR; +use constant DUMP_DIR => "$tdir/common_dump"; + +rmtree DUMP_DIR; use constant RESCAN_WARNINGS => qr/(?i:loader_test|LoaderTest)\d+s? has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method|invalidates \d+ active statement|^Bad table or view/; # skip schema-qualified tables in the Pg tests use constant SOURCE_DDL => qr/CREATE (?:TABLE|VIEW) (?!"dbicsl[.-]test")/i; +use constant SCHEMA_CLASS => 'DBIXCSL_Test::Schema'; + +use constant RESULT_NAMESPACE => [ 'MyResult', 'MyResultTwo' ]; + +use constant RESULTSET_NAMESPACE => [ 'MyResultSet', 'MyResultSetTwo' ]; + sub new { my $class = shift; @@ -111,7 +120,7 @@ sub run_tests { $num_rescans++ if $self->{vendor} eq 'Firebird'; plan tests => @connect_info * - (203 + ($self->{skip_rels} ? 5 : $num_rescans * $col_accessor_map_tests) + $extra_count + ($self->{data_type_tests}{test_count} || 0)); + (206 + ($self->{skip_rels} ? 5 : $num_rescans * $col_accessor_map_tests) + $extra_count + ($self->{data_type_tests}{test_count} || 0)); foreach my $info_idx (0..$#connect_info) { my $info = $connect_info[$info_idx]; @@ -123,7 +132,7 @@ sub run_tests { my $schema_class = $self->setup_schema($info); $self->test_schema($schema_class); - rmtree $DUMP_DIR + rmtree DUMP_DIR unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} && $info_idx == $#connect_info; } } @@ -133,7 +142,7 @@ sub run_only_extra_tests { plan tests => @$connect_info * (4 + ($self->{extra}{count} || 0) + ($self->{data_type_tests}{test_count} || 0)); - rmtree $DUMP_DIR; + rmtree DUMP_DIR; foreach my $info_idx (0..$#$connect_info) { my $info = $connect_info->[$info_idx]; @@ -168,7 +177,7 @@ sub run_only_extra_tests { if (not ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} && $info_idx == $#$connect_info)) { $self->drop_extra_tables_only; - rmtree $DUMP_DIR; + rmtree DUMP_DIR; } } } @@ -198,8 +207,6 @@ my (@statements, @statements_reltests, @statements_advanced, sub setup_schema { my ($self, $connect_info, $expected_count) = @_; - my $schema_class = 'DBIXCSL_Test::Schema'; - my $debug = ($self->{verbose} > 1) ? 1 : 0; if ($ENV{SCHEMA_LOADER_TESTS_USE_MOOSE}) { @@ -214,7 +221,8 @@ sub setup_schema { my %loader_opts = ( constraint => qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)[_-]?)?loader[_-]?test[0-9]+(?!.*_)/i, - relationships => 1, + result_namespace => RESULT_NAMESPACE, + resultset_namespace => RESULTSET_NAMESPACE, additional_classes => 'TestAdditional', additional_base_classes => 'TestAdditionalBase', left_base_classes => [ qw/TestLeftBase/ ], @@ -224,8 +232,7 @@ sub setup_schema { moniker_map => \&_monikerize, custom_column_info => \&_custom_column_info, debug => $debug, - use_namespaces => 0, - dump_directory => $DUMP_DIR, + dump_directory => DUMP_DIR, datetime_timezone => 'Europe/Berlin', datetime_locale => 'de_DE', $self->{use_moose} ? ( @@ -242,14 +249,14 @@ sub setup_schema { $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema}; - Class::Unload->unload($schema_class); + Class::Unload->unload(SCHEMA_CLASS); my $file_count; { my @loader_warnings; local $SIG{__WARN__} = sub { push(@loader_warnings, @_); }; eval qq{ - package $schema_class; + package @{[SCHEMA_CLASS]}; use base qw/DBIx::Class::Schema::Loader/; __PACKAGE__->loader_options(\%loader_opts); @@ -258,7 +265,7 @@ sub setup_schema { ok(!$@, "Loader initialization") or diag $@; - find sub { return if -d; $file_count++ }, $DUMP_DIR; + find sub { return if -d; $file_count++ }, DUMP_DIR; my $standard_sources = not defined $expected_count; @@ -326,8 +333,8 @@ sub setup_schema { } exit if ($file_count||0) != $expected_count; - - return $schema_class; + + return SCHEMA_CLASS; } sub test_schema { @@ -368,6 +375,30 @@ sub test_schema { isa_ok( $rsobj24, "DBIx::Class::ResultSet" ); isa_ok( $rsobj35, "DBIx::Class::ResultSet" ); + # check result_namespace + my @schema_dir = split /::/, SCHEMA_CLASS; + my $result_dir = ref RESULT_NAMESPACE ? ${RESULT_NAMESPACE()}[0] : RESULT_NAMESPACE; + + my $schema_files = [ sort map basename($_), glob catfile(DUMP_DIR, @schema_dir, '*') ]; + + is_deeply $schema_files, [ $result_dir ], + 'first entry in result_namespace exists as a directory'; + + my $result_file_count =()= glob catfile(DUMP_DIR, @schema_dir, $result_dir, '*.pm'); + + ok $result_file_count, + 'Result files dumped to first entry in result_namespace'; + + # parse out the resultset_namespace + my $schema_code = read_file($conn->_loader->get_dump_filename(SCHEMA_CLASS), binmode => ':encoding(UTF-8)'); + + my ($schema_resultset_namespace) = $schema_code =~ /\bresultset_namespace => (.*)/; + $schema_resultset_namespace = eval $schema_resultset_namespace; + die $@ if $@; + + is_deeply $schema_resultset_namespace, RESULTSET_NAMESPACE, + 'resultset_namespace set correctly on Schema'; + my @columns_lt2 = $class2->columns; is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent dbix_class_testcomponentmap testcomponent_fqn meta test_role_method test_role_for_map_method/ ], "Column Ordering" ); @@ -785,7 +816,7 @@ sub test_schema { $class6->column_info('Id2'); ok($id2_info->{is_foreign_key}, 'Foreign key detected'); - unlike slurp($conn->_loader->get_dump_filename($class6)), + unlike read_file($conn->_loader->get_dump_filename($class6), binmode => ':encoding(UTF-8)'), qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\( \s+ "(\w+?)" .*? @@ -793,7 +824,7 @@ qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\( \s+ "\1"/xs, 'did not create two relationships with the same name'; - unlike slurp($conn->_loader->get_dump_filename($class8)), + unlike read_file($conn->_loader->get_dump_filename($class8), binmode => ':encoding(UTF-8)'), qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\( \s+ "(\w+?)" .*? @@ -1090,7 +1121,7 @@ EOF $digest->addfile($fh); }; - find $find_cb, $DUMP_DIR; + find $find_cb, DUMP_DIR; # system "rm -f /tmp/before_rescan/* /tmp/after_rescan/*"; # system "cp $tdir/common_dump/DBIXCSL_Test/Schema/*.pm /tmp/before_rescan"; @@ -1111,7 +1142,7 @@ EOF # system "cp t/_common_dump/DBIXCSL_Test/Schema/*.pm /tmp/after_rescan"; $digest = Digest::MD5->new; - find $find_cb, $DUMP_DIR; + find $find_cb, DUMP_DIR; my $after_digest = $digest->b64digest; is $before_digest, $after_digest, @@ -1244,12 +1275,14 @@ sub monikers_and_classes { $table_name = $$table_name if ref $table_name; + my $result_class = $schema_class->source($source_name)->result_class; + $monikers->{$table_name} = $source_name; - $classes->{$table_name} = $schema_class . q{::} . $source_name; + $classes->{$table_name} = $result_class; # some DBs (Firebird) uppercase everything $monikers->{lc $table_name} = $source_name; - $classes->{lc $table_name} = $schema_class . q{::} . $source_name; + $classes->{lc $table_name} = $result_class; } return ($monikers, $classes); @@ -2150,7 +2183,7 @@ sub DESTROY { my $self = shift; unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) { $self->drop_tables if $self->{_created}; - rmtree $DUMP_DIR + rmtree DUMP_DIR } }