X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=8bf7d676659de9e562fc0d5fd0ee41fc1264b7b8;hb=c9733800;hp=228ade30c3cff25fd61db8d39472f17c4df13cc9;hpb=7f3fd2621c5509873aa30e7a68b7dd670421cc86;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 228ade3..8bf7d67 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;
 }
 
@@ -1036,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
@@ -1074,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
@@ -1425,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) = @_;
@@ -1438,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') {
@@ -1501,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)
           ];
   }
 }
@@ -1700,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' ) {
@@ -1888,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 !!!!
@@ -1909,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}) {
@@ -1937,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) }