From: Mark A. Stratman Date: Fri, 13 May 2011 17:57:42 +0000 (-0500) Subject: added result_roles and result_roles_map options, fixed a bug with accessor collision... X-Git-Tag: 0.07011~121 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d36c8734a5b871d1fe5ce3502e0dad29f4b7375b;hp=937dea41c12b5345cd4f67a8db423ac9beeeaaa8;p=dbsrgits%2FDBIx-Class-Schema-Loader.git added result_roles and result_roles_map options, fixed a bug with accessor collision detection from result_components_map components, fixed some common tests --- diff --git a/Changes b/Changes index 0c47dd0..e3a5d7c 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,10 @@ Revision history for Perl extension DBIx::Class::Schema::Loader + - rename result_component_map to result_components_map (old name still + works) + - fix accessor collision detection for methods from + result_components_map components + - add result_roles and result_roles_map options - fix for mysql rel detection in mixed-case tables on mixed-case filesystems (OSX and Windows) - support for DBD::Firebird diff --git a/lib/DBIx/Class/Schema/Loader.pm b/lib/DBIx/Class/Schema/Loader.pm index bef75c4..c01fdbe 100644 --- a/lib/DBIx/Class/Schema/Loader.pm +++ b/lib/DBIx/Class/Schema/Loader.pm @@ -506,6 +506,8 @@ timbunce: Tim Bunce mst: Matt S. Trout +mstratman: Mark A. Stratman + kane: Jos Boumans waawaamilk: Nigel McNie diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 969ed30..6e11679 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -51,6 +51,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/ default_resultset_class schema_base_class result_base_class + result_roles use_moose overwrite_modifications @@ -87,7 +88,8 @@ __PACKAGE__->mk_group_accessors('simple', qw/ col_collision_map rel_collision_map real_dump_directory - result_component_map + result_components_map + result_roles_map datetime_undef_if_invalid _result_class_methods /); @@ -366,13 +368,13 @@ List of additional components to be loaded into all of your table classes. A good example would be L -=head2 result_component_map +=head2 result_components_map -A hashref of moniker keys and component values. Unlike C, which loads the -given components into every table class, this option allows you to load certain -components for specified tables. For example: +A hashref of moniker keys and component values. Unlike C, which +loads the given components into every Result class, this option allows you to +load certain components for specified Result classes. For example: - result_component_map => { + result_components_map => { StationVisited => '+YourApp::Schema::Component::StationVisited', RouteChange => [ '+YourApp::Schema::Component::RouteChange', @@ -382,6 +384,26 @@ components for specified tables. For example: You may use this in conjunction with C. +=head2 result_roles + +List of L roles to be applied to all of your Result classes. + +=head2 result_roles_map + +A hashref of moniker keys and role values. Unlike C, which +applies the given roles to every Result class, this option allows you to apply +certain roles for specified Result classes. For example: + + result_roles_map => { + StationVisited => [ + 'YourApp::Role::Building', + 'YourApp::Role::Destination', + ], + RouteChange => 'YourApp::Role::TripEvent', + } + +You may use this in conjunction with C. + =head2 use_namespaces This is now the default, to go back to L pass @@ -555,7 +577,7 @@ my $CURRENT_V = 'v7'; my @CLASS_ARGS = qw( schema_base_class result_base_class additional_base_classes - left_base_classes additional_classes components + left_base_classes additional_classes components result_roles ); # ensure that a peice of object data is a valid arrayref, creating @@ -605,25 +627,55 @@ sub new { } } + $self->result_components_map($self->{result_component_map}) + if defined $self->{result_component_map}; + + $self->result_roles_map($self->{result_role_map}) + if defined $self->{result_role_map}; + + croak "the result_roles and result_roles_map options may only be used in conjunction with use_moose=1" + if ((not defined $self->use_moose) || (not $self->use_moose)) + && ((defined $self->result_roles) || (defined $self->result_roles_map)); + $self->_ensure_arrayref(qw/additional_classes additional_base_classes left_base_classes components + result_roles /); $self->_validate_class_args; - if ($self->result_component_map) { - my %rc_map = %{ $self->result_component_map }; + croak "result_components_map must be a hash" + if defined $self->result_components_map + && ref $self->result_components_map ne 'HASH'; + + if ($self->result_components_map) { + my %rc_map = %{ $self->result_components_map }; foreach my $moniker (keys %rc_map) { $rc_map{$moniker} = [ $rc_map{$moniker} ] unless ref $rc_map{$moniker}; } - $self->result_component_map(\%rc_map); + $self->result_components_map(\%rc_map); } else { - $self->result_component_map({}); + $self->result_components_map({}); } - $self->_validate_result_component_map; + $self->_validate_result_components_map; + + croak "result_roles_map must be a hash" + if defined $self->result_roles_map + && ref $self->result_roles_map ne 'HASH'; + + if ($self->result_roles_map) { + my %rr_map = %{ $self->result_roles_map }; + foreach my $moniker (keys %rr_map) { + $rr_map{$moniker} = [ $rr_map{$moniker} ] unless ref $rr_map{$moniker}; + } + $self->result_roles_map(\%rr_map); + } else { + $self->result_roles_map({}); + } + $self->_validate_result_roles_map; if ($self->use_moose) { if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) { @@ -830,14 +882,19 @@ sub _validate_class_args { } } -sub _validate_result_component_map { +sub _validate_result_components_map { my $self = shift; - my $map = $self->result_component_map; - return unless $map && ref $map eq 'HASH'; + foreach my $classes (values %{ $self->result_components_map }) { + $self->_validate_classes('result_components_map', $classes); + } +} + +sub _validate_result_roles_map { + my $self = shift; - foreach my $classes (values %$map) { - $self->_validate_classes('result_component_map', [@$classes]); + foreach my $classes (values %{ $self->result_roles_map }) { + $self->_validate_classes('result_roles_map', $classes); } } @@ -846,7 +903,10 @@ sub _validate_classes { my $key = shift; my $classes = shift; - foreach my $c (@$classes) { + # make a copy to not destroy original + my @classes = @$classes; + + foreach my $c (@classes) { # components default to being under the DBIx::Class namespace unless they # are preceeded with a '+' if ( $key =~ m/component/ && $c !~ s/^\+// ) { @@ -1538,6 +1598,18 @@ sub _inject { $self->_raw_stmt($target, "use base qw/$blist/;"); } +sub _with { + my $self = shift; + my $target = shift; + + my $rlist = join(q{, }, map { qq{'$_'} } @_); + + return unless $rlist; + + warn "$target: with $rlist;" if $self->debug; + $self->_raw_stmt($target, "\nwith $rlist;"); +} + sub _result_namespace { my ($self, $schema_class, $ns) = @_; my @result_namespace; @@ -1601,12 +1673,7 @@ sub _make_src_class { unless $table_class eq $old_class; } -# this was a bad idea, should be ok now without it -# my $table_normalized = lc $table; -# $self->classes->{$table_normalized} = $table_class; -# $self->monikers->{$table_normalized} = $table_moniker; - - $self->classes->{$table} = $table_class; + $self->classes->{$table} = $table_class; $self->monikers->{$table} = $table_moniker; $self->_use ($table_class, @{$self->additional_classes}); @@ -1614,12 +1681,18 @@ sub _make_src_class { my @components = @{ $self->components || [] }; - push @components, @{ $self->result_component_map->{$table_moniker} } - if exists $self->result_component_map->{$table_moniker}; + push @components, @{ $self->result_components_map->{$table_moniker} } + if exists $self->result_components_map->{$table_moniker}; $self->_dbic_stmt($table_class, 'load_components', @components) if @components; $self->_inject($table_class, @{$self->additional_base_classes}); + + my @roles = @{ $self->result_roles || [] }; + push @roles, @{ $self->result_roles_map->{$table_moniker} } + if exists $self->result_roles_map->{$table_moniker}; + + $self->_with($table_class, @roles) if @roles; } sub _is_result_class_method { @@ -1627,20 +1700,29 @@ sub _is_result_class_method { my $table_moniker = $table_name ? $self->_table2moniker($table_name) : ''; - if (not $self->_result_class_methods) { + $self->_result_class_methods({}) + if not defined $self->_result_class_methods; + + if (not exists $self->_result_class_methods->{$table_moniker}) { my (@methods, %methods); my $base = $self->result_base_class || 'DBIx::Class::Core'; my @components = @{ $self->components || [] }; - push @components, @{ $self->result_component_map->{$table_moniker} } - if exists $self->result_component_map->{$table_moniker}; + push @components, @{ $self->result_components_map->{$table_moniker} } + if exists $self->result_components_map->{$table_moniker}; for my $c (@components) { $c = $c =~ /^\+/ ? substr($c,1) : "DBIx::Class::$c"; } - for my $class ($base, @components, $self->use_moose ? 'Moose::Object' : ()) { + my @roles = @{ $self->result_roles || [] }; + + push @roles, @{ $self->result_roles_map->{$table_moniker} } + if exists $self->result_roles_map->{$table_moniker}; + + for my $class ($base, @components, + ($self->use_moose ? 'Moose::Object' : ()), @roles) { $self->ensure_class_loaded($class); push @methods, @{ Class::Inspector->methods($class) || [] }; @@ -1650,9 +1732,9 @@ sub _is_result_class_method { @methods{@methods} = (); - $self->_result_class_methods(\%methods); + $self->_result_class_methods->{$table_moniker} = \%methods; } - my $result_methods = $self->_result_class_methods; + my $result_methods = $self->_result_class_methods->{$table_moniker}; return exists $result_methods->{$name}; } diff --git a/t/lib/TestRole.pm b/t/lib/TestRole.pm new file mode 100644 index 0000000..97fa561 --- /dev/null +++ b/t/lib/TestRole.pm @@ -0,0 +1,7 @@ +package TestRole; + +use Moose::Role; + +sub test_role_method { 'test_role_method works' } + +1; diff --git a/t/lib/TestRoleForMap.pm b/t/lib/TestRoleForMap.pm new file mode 100644 index 0000000..6160bfb --- /dev/null +++ b/t/lib/TestRoleForMap.pm @@ -0,0 +1,7 @@ +package TestRoleForMap; + +use Moose::Role; + +sub test_role_for_map_method { 'test_role_for_map_method works' } + +1; diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index 94bf90a..bc7cd8a 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -102,7 +102,7 @@ sub run_tests { $num_rescans++ if $self->{vendor} eq 'Firebird'; plan tests => @connect_info * - (194 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0)); + (199 + $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]; @@ -193,14 +193,13 @@ sub setup_schema { my $debug = ($self->{verbose} > 1) ? 1 : 0; - if ( - $ENV{SCHEMA_LOADER_TESTS_USE_MOOSE} - && - ! DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose') - ) { - die sprintf ("Missing dependencies for SCHEMA_LOADER_TESTS_USE_MOOSE: %s\n", - DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose') - ); + if ($ENV{SCHEMA_LOADER_TESTS_USE_MOOSE}) { + if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) { + die sprintf ("Missing dependencies for SCHEMA_LOADER_TESTS_USE_MOOSE: %s\n", + DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose')); + } + + $self->{use_moose} = 1; } my %loader_opts = ( @@ -220,11 +219,15 @@ sub setup_schema { dump_directory => $DUMP_DIR, datetime_timezone => 'Europe/Berlin', datetime_locale => 'de_DE', - use_moose => $ENV{SCHEMA_LOADER_TESTS_USE_MOOSE}, + $self->{use_moose} ? ( + use_moose => 1, + result_roles => 'TestRole', + result_roles_map => { LoaderTest2X => 'TestRoleForMap' }, + ) : (), col_collision_map => { '^(can)\z' => 'caught_collision_%s' }, rel_collision_map => { '^(set_primary_key)\z' => 'caught_rel_collision_%s' }, col_accessor_map => \&test_col_accessor_map, - result_component_map => { LoaderTest2X => 'TestComponentForMap', LoaderTest1 => '+TestComponentForMapFQN' }, + result_components_map => { LoaderTest2X => 'TestComponentForMap', LoaderTest1 => '+TestComponentForMapFQN' }, %{ $self->{loader_options} || {} }, ); @@ -357,26 +360,49 @@ sub test_schema { isa_ok( $rsobj35, "DBIx::Class::ResultSet" ); my @columns_lt2 = $class2->columns; - is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent testcomponent_fqn meta/ ], "Column Ordering" ); + is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent dbix_class_testcomponentformap testcomponent_fqn meta test_role_method test_role_for_map_method/ ], "Column Ordering" ); is $class2->column_info('can')->{accessor}, 'caught_collision_can', 'accessor for column name that conflicts with a UNIVERSAL method renamed based on col_collision_map'; - is $class2->column_info('set_primary_key')->{accessor}, undef, - 'accessor for column name that conflicts with a result base class method removed'; + ok (exists $class2->column_info('set_primary_key')->{accessor} + && (not defined $class2->column_info('set_primary_key')->{accessor}), + 'accessor for column name that conflicts with a result base class method removed'); + + ok (exists $class2->column_info('dbix_class_testcomponent')->{accessor} + && (not defined $class2->column_info('dbix_class_testcomponent')->{accessor}), + 'accessor for column name that conflicts with a component class method removed'); - is $class2->column_info('dbix_class_testcomponent')->{accessor}, undef, - 'accessor for column name that conflicts with a component class method removed'; + ok (exists $class2->column_info('dbix_class_testcomponentformap')->{accessor} + && (not defined $class2->column_info('dbix_class_testcomponentformap')->{accessor}), + 'accessor for column name that conflicts with a component class method removed'); - is $class2->column_info('testcomponent_fqn')->{accessor}, undef, - 'accessor for column name that conflicts with a fully qualified component class method removed'; + ok (exists $class2->column_info('testcomponent_fqn')->{accessor} + && (not defined $class2->column_info('testcomponent_fqn')->{accessor}), + 'accessor for column name that conflicts with a fully qualified component class method removed'); - if ($conn->_loader->use_moose) { - is $class2->column_info('meta')->{accessor}, undef, - 'accessor for column name that conflicts with Moose removed'; + if ($self->{use_moose}) { + ok (exists $class2->column_info('meta')->{accessor} + && (not defined $class2->column_info('meta')->{accessor}), + 'accessor for column name that conflicts with Moose removed'); + + ok (exists $class2->column_info('test_role_for_map_method')->{accessor} + && (not defined $class2->column_info('test_role_for_map_method')->{accessor}), + 'accessor for column name that conflicts with a Result role removed'); + + ok (exists $class2->column_info('test_role_method')->{accessor} + && (not defined $class2->column_info('test_role_method')->{accessor}), + 'accessor for column name that conflicts with a Result role removed'); } else { - pass "not removing 'meta' accessor with use_moose disabled"; + ok ((not exists $class2->column_info('meta')->{accessor}), + "not removing 'meta' accessor with use_moose disabled"); + + ok ((not exists $class2->column_info('test_role_for_map_method')->{accessor}), + 'no role method conflicts with use_moose disabled'); + + ok ((not exists $class2->column_info('test_role_method')->{accessor}), + 'no role method conflicts with use_moose disabled'); } my %uniq1 = $class1->unique_constraints; @@ -453,6 +479,18 @@ sub test_schema { 'fully qualified component class from result_component_map not added to not mapped Result'; SKIP: { + skip 'not testing role methods with use_moose disabled', 2 + unless $self->{use_moose}; + + is try { $class1->test_role_method }, 'test_role_method works', + 'role from result_roles applied'; + + is try { $class2->test_role_for_map_method }, + 'test_role_for_map_method works', + 'role from result_roles_map applied'; + } + + SKIP: { can_ok( $class1, 'loader_test1_classmeth' ) or skip "Pre-requisite test failed", 1; is( $class1->loader_test1_classmeth, 'all is well', 'Class method' ); @@ -1257,8 +1295,11 @@ sub create { set_primary_key INTEGER $self->{null}, can INTEGER $self->{null}, dbix_class_testcomponent INTEGER $self->{null}, + dbix_class_testcomponentformap INTEGER $self->{null}, testcomponent_fqn INTEGER $self->{null}, meta INTEGER $self->{null}, + test_role_method INTEGER $self->{null}, + test_role_for_map_method INTEGER $self->{null}, UNIQUE (dat2, dat) ) $self->{innodb} },