Add an internal unique colset finder and relax complex $rs update/delete code
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource.pm
index 58eed49..47ecc87 100644 (file)
@@ -15,13 +15,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 +121,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;
 }
 
@@ -886,12 +891,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<DBIx::Class::Schema/create_ddl_dir> or
 L<DBIx::Class::Schema/deploy>.
@@ -899,7 +913,7 @@ L<DBIx::Class::Schema/deploy>.
 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</default_sqlt_deploy_hook> is called.
+Defaults to L</default_sqlt_deploy_hook>.
 
 Your callback will be passed the $source object representing the
 ResultSource instance being deployed, and the
@@ -919,19 +933,13 @@ and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
 
 =head2 default_sqlt_deploy_hook
 
-=over
-
-=item Arguments: $source, $sqlt_table
-
-=item Return value: undefined
-
-=back
-
-This is the sensible default for L</sqlt_deploy_callback>.
-
-If a method named C<sqlt_deploy_hook> 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<sqlt_deploy_hook> method, and if present
+invokes it B<on the Result class directly>. This is to preserve the
+semantics of C<sqlt_deploy_hook> 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
 
@@ -940,8 +948,8 @@ sub default_sqlt_deploy_hook {
 
   my $class = $self->result_class;
 
-  if ($class and my $hook = $class->can('sqlt_deploy_hook')) {
-    $self->$hook(@_);
+  if ($class and $class->can('sqlt_deploy_hook')) {
+    $class->sqlt_deploy_hook(@_);
   }
 }
 
@@ -1033,6 +1041,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
@@ -1071,6 +1093,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
@@ -1422,6 +1448,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) = @_;
@@ -1435,7 +1487,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') {
@@ -1498,7 +1550,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)
           ];
   }
 }
@@ -1578,7 +1630,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
@@ -1697,12 +1749,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' ) {