new_related works again
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource.pm
index e4d30e9..84c8df9 100644 (file)
@@ -12,13 +12,12 @@ use base qw/DBIx::Class/;
 
 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
   _columns _primaries _unique_constraints name resultset_attributes
-  schema from _relationships column_info_from_storage source_info/);
+  schema from _relationships column_info_from_storage source_info
+  source_name/);
 
 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
   result_class/);
 
-__PACKAGE__->mk_group_ro_accessors('simple' => qw/source_name/);
-
 =head1 NAME
 
 DBIx::Class::ResultSource - Result source object
@@ -82,6 +81,10 @@ Adds columns to the result source. If supplied key => hashref pairs, uses
 the hashref as the column_info for that column. Repeated calls of this
 method will add more columns, not replace them.
 
+The column names given will be created as accessor methods on your
+L<DBIx::Class::Row> objects, you can change the name of the accessor
+by supplying an L</accessor> in the column_info hash.
+
 The contents of the column_info are not set in stone. The following
 keys are currently recognised/used by DBIx::Class:
 
@@ -89,7 +92,7 @@ keys are currently recognised/used by DBIx::Class:
 
 =item accessor
 
-Use this to set the name of the accessor for this column. If unset,
+Use this to set the name of the accessor method for this column. If unset,
 the name of the column will be used.
 
 =item data_type
@@ -140,10 +143,16 @@ generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
 will attempt to retrieve the name of the sequence from the database
 automatically.
 
-=item extras
+=item auto_nextval
+
+Set this to a true value for a column whose value is retrieved
+automatically from an oracle sequence. If you do not use an oracle
+trigger to get the nextval, you have to set sequence as well.
+
+=item extra
 
 This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
-to add extra non-generic data to the column. For example: C<< extras
+to add extra non-generic data to the column. For example: C<< extra
 => { unsigned => 1} >> is used by the MySQL producer to set an integer
 column to unsigned. For more details, see
 L<SQL::Translator::Producer::MySQL>.
@@ -516,6 +525,14 @@ sub add_relationship {
     unless $cond;
   $attrs ||= {};
 
+  # Check foreign and self are right in cond
+  if ( (ref $cond ||'') eq 'HASH') {
+    for (keys %$cond) {
+      $self->throw_exception("Keys of condition should be of form 'foreign.col', not '$_'")
+        if /\./ && !/^foreign\./;
+    }
+  }
+
   my %rels = %{ $self->_relationships };
   $rels{$rel} = { class => $f_source_name,
                   source => $f_source_name,
@@ -629,7 +646,7 @@ sub reverse_relationship_info {
     my $otherrel_info = $othertable->relationship_info($otherrel);
 
     my $back = $othertable->related_source($otherrel);
-    next unless $back->name eq $self->name;
+    next unless $back->source_name eq $self->source_name;
 
     my @othertestconds;
 
@@ -713,16 +730,22 @@ Returns the join structure required for the related result source.
 =cut
 
 sub resolve_join {
-  my ($self, $join, $alias, $seen) = @_;
+  my ($self, $join, $alias, $seen, $force_left) = @_;
   $seen ||= {};
+  $force_left ||= { force => 0 };
   if (ref $join eq 'ARRAY') {
     return map { $self->resolve_join($_, $alias, $seen) } @$join;
   } elsif (ref $join eq 'HASH') {
     return
       map {
         my $as = ($seen->{$_} ? $_.'_'.($seen->{$_}+1) : $_);
-        ($self->resolve_join($_, $alias, $seen),
-          $self->related_source($_)->resolve_join($join->{$_}, $as, $seen));
+        local $force_left->{force};
+        (
+          $self->resolve_join($_, $alias, $seen, $force_left),
+          $self->related_source($_)->resolve_join(
+            $join->{$_}, $as, $seen, $force_left
+          )
+        );
       } keys %$join;
   } elsif (ref $join) {
     $self->throw_exception("No idea how to resolve join reftype ".ref $join);
@@ -732,13 +755,62 @@ sub resolve_join {
     my $as = ($count > 1 ? "${join}_${count}" : $join);
     my $rel_info = $self->relationship_info($join);
     $self->throw_exception("No such relationship ${join}") unless $rel_info;
-    my $type = $rel_info->{attrs}{join_type} || '';
+    my $type;
+    if ($force_left->{force}) {
+      $type = 'left';
+    } else {
+      $type = $rel_info->{attrs}{join_type} || '';
+      $force_left->{force} = 1 if lc($type) eq 'left';
+    }
     return [ { $as => $self->related_source($join)->from,
                -join_type => $type },
              $self->resolve_condition($rel_info->{cond}, $as, $alias) ];
   }
 }
 
+=head2 pk_depends_on
+
+=over 4
+
+=item Arguments: $relname, $rel_data
+
+=back
+
+Determines whether a relation is dependent on an object from this source
+having already been inserted. Takes the name of the relationship and a
+hashref of columns of the related object.
+
+=cut
+
+sub pk_depends_on {
+  my ($self, $relname, $rel_data) = @_;
+  my $cond = $self->relationship_info($relname)->{cond};
+
+  return 0 unless ref($cond) eq 'HASH';
+
+  # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
+
+  my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
+
+  # assume anything that references our PK probably is dependent on us
+  # rather than vice versa, unless the far side is (a) defined or (b)
+  # auto-increment
+
+  my $rel_source = $self->related_source($relname);
+
+  foreach my $p ($self->primary_columns) {
+    if (exists $keyhash->{$p}) {
+      unless (defined($rel_data->{$keyhash->{$p}})
+              || $rel_source->column_info($keyhash->{$p})
+                            ->{is_auto_increment}) {
+        return 0;
+      }
+    }
+  }
+
+  return 1;
+}
+
 =head2 resolve_condition
 
 =over 4
@@ -753,6 +825,8 @@ a related conditional from that object.
 
 =cut
 
+our $UNRESOLVABLE_CONDITION = \'1 = 0';
+
 sub resolve_condition {
   my ($self, $cond, $as, $for) = @_;
   #warn %$cond;
@@ -767,10 +841,19 @@ sub resolve_condition {
         $self->throw_exception("Invalid rel cond val ${v}");
       if (ref $for) { # Object
         #warn "$self $k $for $v";
+        unless ($for->has_column_loaded($v)) {
+          if ($for->in_storage) {
+            $self->throw_exception("Column ${v} not loaded on ${for} trying to reolve relationship");
+          }
+          return $UNRESOLVABLE_CONDITION;
+        }
         $ret{$k} = $for->get_column($v);
+        #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
         #warn %ret;
       } elsif (!defined $for) { # undef, i.e. "no object"
         $ret{$k} = undef;
+      } elsif (ref $as eq 'HASH') { # reverse hashref
+        $ret{$v} = $as->{$k};
       } elsif (ref $as) { # reverse object
         $ret{$v} = $as->get_column($k);
       } elsif (!defined $as) { # undef, i.e. "no reverse object"
@@ -874,6 +957,16 @@ sub resolve_prefetch {
       $self->throw_exception(
         "Can't prefetch has_many ${pre} (join cond too complex)")
         unless ref($rel_info->{cond}) eq 'HASH';
+      my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
+      if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
+                         keys %{$collapse}) {
+        my ($last) = ($fail =~ /([^\.]+)$/);
+        $self->throw_exception(
+          "Can't prefetch multiple has_many rels ${last} and ${pre}"
+          .(length($as_prefix) ? "at the same level (${as_prefix})"
+                               : "at top level"
+        ));
+      }
       #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
       #              values %{$rel_info->{cond}};
       $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
@@ -955,7 +1048,9 @@ but is cached from then on unless resultset_class changes.
 
 Set the class of the resultset, this is useful if you want to create your
 own resultset methods. Create your own class derived from
-L<DBIx::Class::ResultSet>, and set it here. 
+L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
+this method returns the name of the existing resultset class, if one
+exists.
 
 =head2 resultset_attributes
 
@@ -975,7 +1070,11 @@ sub resultset {
   ) if scalar @_;
 
   return $self->resultset_class->new(
-    $self, $self->{resultset_attributes}
+    $self,
+    {
+      %{$self->{resultset_attributes}},
+      %{$self->schema->default_resultset_attributes}
+    },
   );
 }
 
@@ -1028,6 +1127,15 @@ sub throw_exception {
   }
 }
 
+=head2 sqlt_deploy_hook($sqlt_table)
+
+An optional sub which you can declare in your own Schema class that will get 
+passed the L<SQL::Translator::Schema::Table> object when you deploy the schema
+via L</create_ddl_dir> or L</deploy>.
+
+For an example of what you can do with this, see 
+L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
+
 =head1 AUTHORS
 
 Matt S. Trout <mst@shadowcatsystems.co.uk>