first crack at recording metadata about m2m rels historic_rejected/introspectable_m2m_merge
Robert Buels [Thu, 7 Apr 2011 00:24:33 +0000 (17:24 -0700)]
lib/DBIx/Class/Relationship/ManyToMany.pm
lib/DBIx/Class/ResultSource.pm
lib/DBIx/Class/ResultSourceProxy.pm
t/relationship/m2m_info.t [new file with mode: 0644]

index a6bedc5..c4da262 100644 (file)
@@ -35,6 +35,13 @@ sub many_to_many {
     my $set_meth = "set_${meth}";
     my $rs_meth = "${meth}_rs";
 
+    #record many-to-many metadata
+    $class->register_m2m( $meth, {
+        rel   => $rel,
+        frel  => $f_rel,
+        ( defined $rel_attrs ? (attrs => $rel_attrs) : ()),
+    });
+
     for ($add_meth, $remove_meth, $set_meth, $rs_meth) {
       if ( $class->can ($_) ) {
         carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK};
index 9489f49..ffbdfe9 100644 (file)
@@ -18,7 +18,7 @@ use base qw/DBIx::Class/;
 __PACKAGE__->mk_group_accessors(simple => qw/
   source_name name source_info
   _ordered_columns _columns _primaries _unique_constraints
-  _relationships resultset_attributes
+  _relationships _many_to_many resultset_attributes
   column_info_from_storage
 /);
 
@@ -119,6 +119,7 @@ sub new {
   $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
   $new->{_columns} = { %{$new->{_columns}||{}} };
   $new->{_relationships} = { %{$new->{_relationships}||{}} };
+  $new->{_many_to_many}  = { %{$new->{_many_to_many}||{}} };
   $new->{name} ||= "!!NAME NOT SET!!";
   $new->{_columns_info_loaded} ||= 0;
   return $new;
@@ -1515,6 +1516,76 @@ sub _resolve_join {
   }
 }
 
+=head2 m2ms
+
+=over 4
+
+=item Arguments: None
+
+=item Return value: List of many_to_many relationship names
+
+=back
+
+  my @m2m_names = $source->m2ms();
+
+Returns all many_to_many names for this source.
+b
+=cut
+
+sub m2ms {
+    my ( $self ) = @_;
+    return keys %{ $self->_many_to_many };
+}
+
+=head2 m2m_info
+
+=over 4
+
+=item Arguments: $m2m_name
+
+=item Return value: Hashref of relation data,
+
+=back
+
+Returns a hashref of information for the specified many_to_many relationship
+name. The keys/values are:
+
+  { rel   => $local_relname,
+    frel  => $foreign_relname,
+    attrs => { ... },
+  }
+
+=cut
+
+sub m2m_info {
+    my ( $self, $m ) = @_;
+    return $self->_many_to_many->{ $m };
+}
+sub register_m2m {
+    my ( $self, $m, $info ) = @_;
+    $self->_many_to_many->{$m} = $info;
+}
+
+=head2 has_m2m
+
+=over 4
+
+=item Arguments: $m2m_name
+
+=item Return value: 1/0 (true/false)
+
+=back
+
+Returns true if the source has a many_to_many of this name, false otherwise.
+
+=cut
+
+sub has_m2m {
+    my ( $self, $m ) = @_;
+    return exists $self->_many_to_many->{ $m };
+}
+
+
 sub pk_depends_on {
   carp 'pk_depends_on is a private method, stop calling it';
   my $self = shift;
index 1f74eea..e37d4be 100644 (file)
@@ -45,6 +45,11 @@ sub add_relationship {
   $class->register_relationship($rel => $source->relationship_info($rel));
 }
 
+sub register_m2m {
+  my ($class, $rel, @rest) = @_;
+  my $source = $class->result_source_instance;
+  $source->register_m2m( $rel => @rest );
+}
 
 # legacy resultset_class accessor, seems to be used by cdbi only
 sub iterator_class { shift->result_source_instance->resultset_class(@_) }
diff --git a/t/relationship/m2m_info.t b/t/relationship/m2m_info.t
new file mode 100644 (file)
index 0000000..a178dde
--- /dev/null
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+my $cd = $schema->source('CD');
+ok( $cd->has_m2m('producers'), 'CD has a producers m2m' );
+
+is_deeply( [ sort $cd->m2ms ],
+           [ 'producers', 'producers_sorted' ],
+           'got right list of m2ms' );
+
+is_deeply( $cd->m2m_info('producers'),
+           { rel  => 'cd_to_producer',
+             frel => 'producer',
+           },
+           'm2m_info for CD producers is right',
+         );
+
+done_testing;