X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRelationship%2FAccessor.pm;h=8fdeab2d00f7064b507367e002f7a834bb983b6a;hp=a408b69f1b647f4a43a7de3db4df20b1ecad5b84;hb=09d8fb4a05e6cd025924cc08e41484f17a116695;hpb=12e7015aa9372aeaf1aaa7e125b8ac8da216deb5

diff --git a/lib/DBIx/Class/Relationship/Accessor.pm b/lib/DBIx/Class/Relationship/Accessor.pm
index a408b69..8fdeab2 100644
--- a/lib/DBIx/Class/Relationship/Accessor.pm
+++ b/lib/DBIx/Class/Relationship/Accessor.pm
@@ -25,8 +25,15 @@ sub add_relationship_accessor {
 
   if ($acc_type eq 'single') {
 
-    quote_sub "${class}::${rel}" => sprintf(<<'EOC', perlstring $rel);
+    my @qsub_args = ( {}, {
+      attributes => [qw(
+        DBIC_method_is_single_relationship_accessor
+        DBIC_method_is_generated_from_resultsource_metadata
+      )]
+    });
+
 
+    quote_sub "${class}::${rel}" => sprintf(<<'EOC', perlstring $rel), @qsub_args;
       my $self = shift;
 
       if (@_) {
@@ -100,6 +107,38 @@ EOC
         return $pk_val;
       },
     });
+
+
+    # god this is horrible...
+    my $acc =
+      $rsrc->columns_info->{$rel}{accessor}
+        ||
+      $rel
+    ;
+
+    # because CDBI may elect to never make an accessor at all...
+    if( my $main_cref = $class->can($acc) ) {
+
+      attributes->import(
+        $class,
+        $main_cref,
+        qw(
+          DBIC_method_is_filter_relationship_accessor
+          DBIC_method_is_generated_from_resultsource_metadata
+        ),
+      );
+
+      if( my $extra_cref = $class->can("_${acc}_accessor") ) {
+        attributes->import(
+          $class,
+          $extra_cref,
+          qw(
+            DBIC_method_is_filter_relationship_extra_accessor
+            DBIC_method_is_generated_from_resultsource_metadata
+          ),
+        );
+      }
+    }
   }
   elsif ($acc_type eq 'multi') {
 
@@ -108,6 +147,8 @@ EOC
       {},
       {
         attributes => [qw(
+          DBIC_method_is_multi_relationship_accessor
+          DBIC_method_is_generated_from_resultsource_metadata
           DBIC_method_is_indirect_sugar
         )]
       },
@@ -121,6 +162,11 @@ EOC
 EOC
 
 
+    $qsub_args[1]{attributes}[0]
+      =~ s/^DBIC_method_is_multi_relationship_accessor$/DBIC_method_is_multi_relationship_extra_accessor/
+    or die "Unexpected attr '$qsub_args[1]{attributes}[0]' ...";
+
+
     quote_sub "${class}::${rel}_rs", sprintf( <<'EOC', perlstring $rel ), @qsub_args;
       DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call;
       shift->related_resultset(%s)->search_rs( @_ )