allow subclassing of methods proxied to _writer_storage

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource.pm

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index f50cffd..24018f3 100644 (file)
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -6,7 +6,6 @@ use warnings;
 use DBIx::Class::ResultSet;
 use DBIx::Class::ResultSourceHandle;
 use Carp::Clan qw/^DBIx::Class/;
-use Storable;
 
 use base qw/DBIx::Class/;
 
@@ -40,8 +39,6 @@ DBIx::Class::ResultSource - Result source object
   # Create a query (view) based result source, in a result class
   package MyDB::Schema::Result::Year2000CDs;
 
-  use DBIx::Class::ResultSource::View;
-
   __PACKAGE__->load_components('Core');
   __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
 
@@ -245,9 +242,15 @@ automatically.
 
 =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.
+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
+L</sequence> value as well.
+
+Also set this for MSSQL columns with the 'uniqueidentifier'
+L<DBIx::Class::ResultSource/data_type> whose values you want to automatically
+generate using C<NEWID()>, unless they are a primary key in which case this will
+be done anyway.
 
 =item extra
 
@@ -580,7 +583,10 @@ optional constraint name.
 sub name_unique_constraint {
   my ($self, $cols) = @_;
 
-  return join '_', $self->name, @$cols;
+  my $name = $self->name;
+  $name = $$name if (ref $name eq 'SCALAR');
+
+  return join '_', $name, @$cols;
 }
 
 =head2 unique_constraints
@@ -1230,9 +1236,10 @@ sub _resolve_join {
     my $type;
     if ($force_left) {
       $type = 'left';
-    } else {
-      $type = $rel_info->{attrs}{join_type} || '';
-      $force_left = 1 if lc($type) eq 'left';
+    }
+    else {
+      $type = $rel_info->{attrs}{join_type};
+      $force_left = 1 if lc($type||'') eq 'left';
     }
 
     my $rel_src = $self->related_source($join);
@@ -1258,18 +1265,22 @@ sub pk_depends_on {
 # hashref of columns of the related object.
 sub _pk_depends_on {
   my ($self, $relname, $rel_data) = @_;
-  my $cond = $self->relationship_info($relname)->{cond};
 
+  my $relinfo = $self->relationship_info($relname);
+
+  # don't assume things if the relationship direction is specified
+  return $relinfo->{attrs}{is_foreign_key_constraint}
+    if exists ($relinfo->{attrs}{is_foreign_key_constraint});
+
+  my $cond = $relinfo->{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) {
@@ -1311,10 +1322,14 @@ sub _resolve_condition {
         #warn "$self $k $for $v";
         unless ($for->has_column_loaded($v)) {
           if ($for->in_storage) {
-            $self->throw_exception(
-              "Column ${v} not loaded or not passed to new() prior to insert()"
-                ." on ${for} trying to resolve relationship (maybe you forgot "
-                  ."to call ->discard_changes to get defaults from the db)"
+            $self->throw_exception(sprintf
+              'Unable to resolve relationship from %s to %s: column %s.%s not '
+            . 'loaded from storage (or not passed to new() prior to insert()). '
+            . 'Maybe you forgot to call ->discard_changes to get defaults from the db.',
+
+              $for->result_source->source_name,
+              $as,
+              $as, $v,
             );
           }
           return $UNRESOLVABLE_CONDITION;
@@ -1447,7 +1462,7 @@ sub _resolve_prefetch {
     $p = $p->{$_} for (@$pref_path, $pre);
 
     $self->throw_exception (
-      "Unable to resolve prefetch $pre - join alias map does not contain an entry for path: "
+      "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
       . join (' -> ', @$pref_path, $pre)
     ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );