X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=6599a4a67586d18909d62ea5929dc2aeda67bbfa;hb=0c11ad0ee5c8407f6b87d6e15c62a1b445076dc0;hp=0e9d1bd5f2a78efb7377e27776b15eb8c773e328;hpb=03460bef425a7626fc5e3ce4b25b66fa347f5c23;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 0e9d1bd..6599a4a 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -8,6 +8,7 @@ use DBIx::Class::ResultSourceHandle; use DBIx::Class::Exception; use DBIx::Class::Carp; +use Devel::GlobalDestruction; use Try::Tiny; use List::Util 'first'; use Scalar::Util qw/blessed weaken isweak/; @@ -15,13 +16,19 @@ use namespace::clean; use base qw/DBIx::Class/; -__PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns - _columns _primaries _unique_constraints name resultset_attributes - from _relationships column_info_from_storage source_info - source_name sqlt_deploy_callback/); +__PACKAGE__->mk_group_accessors(simple => qw/ + source_name name source_info + _ordered_columns _columns _primaries _unique_constraints + _relationships resultset_attributes + column_info_from_storage +/); -__PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class - result_class/); +__PACKAGE__->mk_group_accessors(component_class => qw/ + resultset_class + result_class +/); + +__PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' ); =head1 NAME @@ -115,7 +122,6 @@ 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; } @@ -253,8 +259,20 @@ generate a new key value. If not specified, L will attempt to retrieve the name of the sequence from the database automatically. +=item retrieve_on_insert + + { retrieve_on_insert => 1 } + +For every column where this is set to true, DBIC will retrieve the RDBMS-side +value upon a new row insertion (normally only the autoincrement PK is +retrieved on insert). C is used automatically if +supported by the underlying storage, otherwise an extra SELECT statement is +executed to retrieve the missing data. + =item auto_nextval + { auto_nextval => 1 } + Set this to a true value for a column whose value is retrieved automatically from a sequence or function (if supported by your Storage driver.) For a sequence, if you do not use a trigger to get the nextval, you have to set the @@ -874,12 +892,21 @@ sub unique_constraint_columns { =over -=item Arguments: $callback +=item Arguments: $callback_name | \&callback_code + +=item Return value: $callback_name | \&callback_code =back __PACKAGE__->sqlt_deploy_callback('mycallbackmethod'); + or + + __PACKAGE__->sqlt_deploy_callback(sub { + my ($source_instance, $sqlt_table) = @_; + ... + } ); + An accessor to set a callback to be called during deployment of the schema via L or L. @@ -887,7 +914,7 @@ L. The callback can be set as either a code reference or the name of a method in the current result class. -If not set, the L is called. +Defaults to L. Your callback will be passed the $source object representing the ResultSource instance being deployed, and the @@ -907,19 +934,13 @@ and call L. =head2 default_sqlt_deploy_hook -=over - -=item Arguments: $source, $sqlt_table - -=item Return value: undefined - -=back - -This is the sensible default for L. - -If a method named C exists in your Result class, it -will be called and passed the current C<$source> and the -C<$sqlt_table> being deployed. +This is the default deploy hook implementation which checks if your +current Result class has a C method, and if present +invokes it B. This is to preserve the +semantics of C which was originally designed to expect +the Result class name and the +L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being +deployed. =cut @@ -1021,6 +1042,20 @@ sub resultset { ); } +=head2 name + +=over 4 + +=item Arguments: None + +=item Result value: $name + +=back + +Returns the name of the result source, which will typically be the table +name. This may be a scalar reference if the result source has a non-standard +name. + =head2 source_name =over 4 @@ -1059,6 +1094,10 @@ Returns an expression of the source to be supplied to storage to specify retrieval from this source. In the case of a database, the required FROM clause contents. +=cut + +sub from { die 'Virtual method!' } + =head2 schema =over 4 @@ -1410,6 +1449,32 @@ sub _compare_relationship_keys { ; } +# optionally takes either an arrayref of column names, or a hashref of already +# retrieved colinfos +# returns an arrayref of column names of the shortest unique constraint +# (matching some of the input if any), giving preference to the PK +sub _identifying_column_set { + my ($self, $cols) = @_; + + my %unique = $self->unique_constraints; + my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||()); + + # always prefer the PK first, and then shortest constraints first + USET: + for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) { + next unless $set && @$set; + + for (@$set) { + next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} ); + } + + # copy so we can mangle it at will + return [ @$set ]; + } + + return undef; +} + # Returns the {from} structure used to express JOIN conditions sub _resolve_join { my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_; @@ -1423,7 +1488,7 @@ sub _resolve_join { $jpath = [@$jpath]; # copy - if (not defined $join) { + if (not defined $join or not length $join) { return (); } elsif (ref $join eq 'ARRAY') { @@ -1486,7 +1551,7 @@ sub _resolve_join { -alias => $as, -relation_chain_depth => $seen->{-relation_chain_depth} || 0, }, - $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join) + scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join) ]; } } @@ -1566,7 +1631,7 @@ sub _resolve_condition { # FIXME sanity check until things stabilize, remove at some point $self->throw_exception ( - "A join-free condition returned for relationship '$relname' whithout a row-object to chain from" + "A join-free condition returned for relationship '$relname' without a row-object to chain from" ) unless $obj_rel; # FIXME another sanity check @@ -1685,12 +1750,11 @@ sub _resolve_condition { # array of column names for each of those relationships. Column names are # prefixed relative to the current source, in accordance with where they appear # in the supplied relationships. - sub _resolve_prefetch { my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_; $pref_path ||= []; - if (not defined $pre) { + if (not defined $pre or not length $pre) { return (); } elsif( ref $pre eq 'ARRAY' ) { @@ -1873,16 +1937,9 @@ sub handle { }); } -{ - my $global_phase_destroy; - - # SpeedyCGI runs END blocks every cycle but keeps object instances - # hence we have to disable the globaldestroy hatch, and rely on the - # eval trap below (which appears to work, but is risky done so late) - END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy } - - sub DESTROY { - return if $global_phase_destroy; +my $global_phase_destroy; +sub DESTROY { + return if $global_phase_destroy ||= in_global_destruction; ###### # !!! ACHTUNG !!!! @@ -1894,25 +1951,21 @@ sub handle { # we are trying to save to reattach back to the source we are destroying. # The relevant code checking refcounts is in ::Schema::DESTROY() - # if we are not a schema instance holder - we don't matter - return if( - ! ref $_[0]->{schema} - or - isweak $_[0]->{schema} - ); - - # weaken our schema hold forcing the schema to find somewhere else to live - # during global destruction (if we have not yet bailed out) this will throw - # which will serve as a signal to not try doing anything else - local $@; - eval { - weaken $_[0]->{schema}; - 1; - } or do { - $global_phase_destroy = 1; - return; - }; + # if we are not a schema instance holder - we don't matter + return if( + ! ref $_[0]->{schema} + or + isweak $_[0]->{schema} + ); + # weaken our schema hold forcing the schema to find somewhere else to live + # during global destruction (if we have not yet bailed out) this will throw + # 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 $@; + eval { + weaken $_[0]->{schema}; # if schema is still there reintroduce ourselves with strong refs back to us if ($_[0]->{schema}) { @@ -1922,7 +1975,13 @@ sub handle { $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0]; } } - } + + 1; + } or do { + $global_phase_destroy = 1; + }; + + return; } sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) } @@ -1983,9 +2042,9 @@ metadata from storage as necessary. This is *deprecated*, and should not be used. It will be removed before 1.0. -=head1 AUTHORS +=head1 AUTHOR AND CONTRIBUTORS -Matt S. Trout +See L and L in DBIx::Class =head1 LICENSE