X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=f6e3923cd50ea7ebe4205016b91df89bed826a67;hb=7648acb5;hp=3c4566299e3d18e8eee8a8de329ea59468983920;hpb=8a3e2074f4cc6dddf03f7ed781cea8143cfa0acd;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 3c45662..f6e3923 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -3,26 +3,24 @@ package DBIx::Class::ResultSource; use strict; use warnings; -use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/; - -use DBIx::Class::ResultSet; -use DBIx::Class::ResultSourceHandle; +use base 'DBIx::Class::ResultSource::RowParser'; use DBIx::Class::Carp; -use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION'; +use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try fail_on_internal_call ); use SQL::Abstract 'is_literal_value'; use Devel::GlobalDestruction; -use Try::Tiny; -use List::Util 'first'; use Scalar::Util qw/blessed weaken isweak/; +# FIXME - somehow breaks ResultSetManager, do not remove until investigated +use DBIx::Class::ResultSet; + use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/ source_name name source_info _ordered_columns _columns _primaries _unique_constraints _relationships resultset_attributes - column_info_from_storage + column_info_from_storage sqlt_deploy_callback /); __PACKAGE__->mk_group_accessors(component_class => qw/ @@ -30,8 +28,6 @@ __PACKAGE__->mk_group_accessors(component_class => qw/ result_class /); -__PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' ); - =head1 NAME DBIx::Class::ResultSource - Result source object @@ -131,6 +127,7 @@ sub new { $new->{_relationships} = { %{$new->{_relationships}||{}} }; $new->{name} ||= "!!NAME NOT SET!!"; $new->{_columns_info_loaded} ||= 0; + $new->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook'; return $new; } @@ -355,7 +352,10 @@ sub add_columns { return $self; } -sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB +sub add_column { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + shift->add_columns(@_) +} =head2 has_column @@ -404,12 +404,12 @@ sub column_info { if ( ! $self->_columns->{$column}{data_type} and ! $self->{_columns_info_loaded} and $self->column_info_from_storage - and my $stor = try { $self->storage } ) + and my $stor = dbic_internal_try { $self->schema->storage } ) { $self->{_columns_info_loaded}++; # try for the case of storage without table - try { + dbic_internal_try { my $info = $stor->columns_info_for( $self->from ); my $lc_info = { map { (lc $_) => $info->{$_} } @@ -476,18 +476,18 @@ sub columns_info { my $colinfo = $self->_columns; if ( - first { ! $_->{data_type} } values %$colinfo - and ! $self->{_columns_info_loaded} and $self->column_info_from_storage and - my $stor = try { $self->storage } + grep { ! $_->{data_type} } values %$colinfo + and + my $stor = dbic_internal_try { $self->schema->storage } ) { $self->{_columns_info_loaded}++; # try for the case of storage without table - try { + dbic_internal_try { my $info = $stor->columns_info_for( $self->from ); my $lc_info = { map { (lc $_) => $info->{$_} } @@ -580,7 +580,10 @@ sub remove_columns { $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]); } -sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB +sub remove_column { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + shift->remove_columns(@_) +} =head2 set_primary_key @@ -800,10 +803,12 @@ See also L. =cut sub add_unique_constraints { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + my $self = shift; my @constraints = @_; - if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) { + if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) { # with constraint name while (my ($name, $constraint) = splice @constraints, 0, 2) { $self->add_unique_constraint($name => $constraint); @@ -940,11 +945,11 @@ sub unique_constraint_columns { =back - __PACKAGE__->sqlt_deploy_callback('mycallbackmethod'); + __PACKAGE__->result_source_instance->sqlt_deploy_callback('mycallbackmethod'); or - __PACKAGE__->sqlt_deploy_callback(sub { + __PACKAGE__->result_source_instance->sqlt_deploy_callback(sub { my ($source_instance, $sqlt_table) = @_; ... } ); @@ -1092,12 +1097,15 @@ Store a collection of resultset attributes, that will be set on every L produced from this result source. B: C comes with its own set of issues and -bugs! While C isn't deprecated per se, its usage is -not recommended! +bugs! Notably the contents of the attributes are B, which +greatly hinders composability (things like L can not possibly be respected). +While C isn't deprecated per se, you are strongly urged +to seek alternatives. Since relationships use attributes to link tables together, the "default" attributes you set may cause unpredictable and undesired behavior. Furthermore, -the defaults cannot be turned off, so you are stuck with them. +the defaults B, so you are stuck with them. In most cases, what you should actually be using are project-specific methods: @@ -1131,7 +1139,7 @@ sub resultset { $self->resultset_class->new( $self, { - try { %{$self->schema->default_resultset_attributes} }, + ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ), %{$self->{resultset_attributes}}, }, ); @@ -1256,7 +1264,10 @@ Returns the L for the current schema. =cut -sub storage { shift->schema->storage; } +sub storage { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + $_[0]->schema->storage +} =head2 add_relationship @@ -1360,29 +1371,6 @@ sub add_relationship { $self->_relationships(\%rels); return $self; - -# XXX disabled. doesn't work properly currently. skip in tests. - - my $f_source = $self->schema->source($f_source_name); - unless ($f_source) { - $self->ensure_class_loaded($f_source_name); - $f_source = $f_source_name->result_source; - #my $s_class = ref($self->schema); - #$f_source_name =~ m/^${s_class}::(.*)$/; - #$self->schema->register_class(($1 || $f_source_name), $f_source_name); - #$f_source = $self->schema->source($f_source_name); - } - return unless $f_source; # Can't test rel without f_source - - try { $self->_resolve_join($rel, 'me', {}, []) } - catch { - # If the resolve failed, back out and re-throw the error - delete $rels{$rel}; - $self->_relationships(\%rels); - $self->throw_exception("Error creating relationship $rel: $_"); - }; - - 1; } =head2 relationships @@ -1402,7 +1390,7 @@ Returns all relationship names for this source. =cut sub relationships { - return keys %{shift->_relationships}; + keys %{$_[0]->_relationships}; } =head2 relationship_info @@ -1495,7 +1483,7 @@ sub reverse_relationship_info { # to use the source_names, otherwise we will use the actual classes # the schema may be partial - my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) } + my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) } or next; if ($registered_source_name) { @@ -1584,7 +1572,7 @@ sub _minimal_valueset_satisfying_constraint { $args->{columns_info} ||= $self->columns_info; - my $vals = $self->storage->_extract_fixed_condition_columns( + my $vals = $self->schema->storage->_extract_fixed_condition_columns( $args->{values}, ($args->{carp_on_nulls} ? 'consider_nulls' : undef ), ); @@ -1673,7 +1661,7 @@ sub _resolve_join { $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left'; # the actual seen value will be incremented by the recursion - my $as = $self->storage->relname_to_table_alias( + my $as = $self->schema->storage->relname_to_table_alias( $rel, ($seen->{$rel} && $seen->{$rel} + 1) ); @@ -1692,7 +1680,7 @@ sub _resolve_join { } else { my $count = ++$seen->{$join}; - my $as = $self->storage->relname_to_table_alias( + my $as = $self->schema->storage->relname_to_table_alias( $join, ($count > 1 && $count) ); @@ -1708,14 +1696,20 @@ sub _resolve_join { , -join_path => [@$jpath, { $join => $as } ], -is_single => ( - (! $rel_info->{attrs}{accessor}) + ! $rel_info->{attrs}{accessor} + or + $rel_info->{attrs}{accessor} eq 'single' or - first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/) + $rel_info->{attrs}{accessor} eq 'filter' ), -alias => $as, -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1, }, - scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join) + $self->_resolve_relationship_condition( + rel_name => $join, + self_alias => $alias, + foreign_alias => $as, + )->{condition}, ]; } } @@ -1919,14 +1913,16 @@ sub _resolve_relationship_condition { ) ; -#TEMP - my $rel_rsrc;# = $self->related_source($args->{rel_name}); + my $rel_rsrc = $self->related_source($args->{rel_name}); + my $storage = $self->schema->storage; if (exists $args->{foreign_values}) { -# TEMP - $rel_rsrc ||= $self->related_source($args->{rel_name}); - if (defined blessed $args->{foreign_values}) { + if (! defined $args->{foreign_values} ) { + # fallback: undef => {} + $args->{foreign_values} = {}; + } + elsif (defined blessed $args->{foreign_values}) { $self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" ) unless $args->{foreign_values}->isa('DBIx::Class::Row'); @@ -1939,12 +1935,41 @@ sub _resolve_relationship_condition { $args->{foreign_values} = { $args->{foreign_values}->get_columns }; } - elsif (! defined $args->{foreign_values} or ref $args->{foreign_values} eq 'HASH') { - my $ri = { map { $_ => 1 } $rel_rsrc->relationships }; - my $ci = $rel_rsrc->columns_info; - ! exists $ci->{$_} and ! exists $ri->{$_} and $self->throw_exception( - "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" - ) for keys %{ $args->{foreign_values} ||= {} }; + elsif ( ref $args->{foreign_values} eq 'HASH' ) { + + # re-build {foreign_values} excluding identically named rels + if( keys %{$args->{foreign_values}} ) { + + my ($col_idx, $rel_idx) = map + { { map { $_ => 1 } $rel_rsrc->$_ } } + qw( columns relationships ) + ; + + my $equivalencies = $storage->_extract_fixed_condition_columns( + $args->{foreign_values}, + 'consider nulls', + ); + + $args->{foreign_values} = { map { + # skip if relationship *and* a non-literal ref + # this means a multicreate stub was passed in + ( + $rel_idx->{$_} + and + length ref $args->{foreign_values}{$_} + and + ! is_literal_value($args->{foreign_values}{$_}) + ) + ? () + : ( $_ => ( + ! $col_idx->{$_} + ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" ) + : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION ) + ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" ) + : $args->{foreign_values}{$_} + )) + } keys %{$args->{foreign_values}} }; + } } else { $self->throw_exception( @@ -1987,9 +2012,6 @@ sub _resolve_relationship_condition { "The join-free condition returned for $exception_rel_id must be a hash reference" ) unless ref $jfc eq 'HASH'; -# TEMP - $rel_rsrc ||= $self->related_source($args->{rel_name}); - my ($joinfree_alias, $joinfree_source); if (defined $args->{self_result_object}) { $joinfree_alias = $args->{foreign_alias}; @@ -2013,7 +2035,7 @@ sub _resolve_relationship_condition { exists $fq_col_list->{$_} or $self->throw_exception ( "The join-free condition returned for $exception_rel_id may only " . 'contain keys that are fully qualified column names of the corresponding source ' - . "(it returned '$_')" + . "'$joinfree_alias' (instead it returned '$_')" ) for keys %$jfc; ( @@ -2119,13 +2141,18 @@ sub _resolve_relationship_condition { $self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :("); } - $self->throw_exception(ucfirst "$exception_rel_id does not resolve to a join-free condition fragment") if ( + if ( $args->{require_join_free_condition} and ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION ) - ); - - my $storage = $self->schema->storage; + ) { + $self->throw_exception( + ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment", + exists $args->{foreign_values} + ? "'foreign_values'-based reversed-" + : '' + ); + } # we got something back - sanity check and infer values if we can my @nonvalues; @@ -2184,9 +2211,6 @@ sub _resolve_relationship_condition { next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION; -# TEMP - $rel_rsrc ||= $self->related_source($args->{rel_name}); - # there is no way to know who is right and who is left in a cref # therefore a full blown resolution call, and figure out the # direction a bit further below @@ -2257,7 +2281,7 @@ sub related_source { # if we are not registered with a schema - just use the prototype # however if we do have a schema - ask for the source by name (and # throw in the process if all fails) - if (my $schema = try { $self->schema }) { + if (my $schema = dbic_internal_try { $self->schema }) { $schema->source($self->relationship_info($rel)->{source}); } else { @@ -2307,6 +2331,7 @@ relationship definitions. =cut sub handle { + require DBIx::Class::ResultSourceHandle; return DBIx::Class::ResultSourceHandle->new({ source_moniker => $_[0]->source_name, @@ -2347,17 +2372,23 @@ sub DESTROY { # which will serve as a signal to not try doing anything else # however beware - on older perls the exception seems randomly untrappable # due to some weird race condition during thread joining :((( - local $@; + local $SIG{__DIE__} if $SIG{__DIE__}; + local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT; eval { weaken $_[0]->{schema}; # if schema is still there reintroduce ourselves with strong refs back to us if ($_[0]->{schema}) { my $srcregs = $_[0]->{schema}->source_registrations; - for (keys %$srcregs) { - next unless $srcregs->{$_}; - $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0]; - } + + defined $srcregs->{$_} + and + $srcregs->{$_} == $_[0] + and + $srcregs->{$_} = $_[0] + and + last + for keys %$srcregs; } 1; @@ -2365,7 +2396,10 @@ sub DESTROY { $global_phase_destroy = 1; }; - return; + # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage + # collected before leaving this scope. Depending on the code above, this + # may very well be just a preventive measure guarding future modifications + undef; } sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }