X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=blobdiff_plain;f=t%2Flib%2FIntrospectM2M.pm;fp=t%2Flib%2FIntrospectM2M.pm;h=48521708a2760fc7f55aec47b426750ceda1d115;hp=0000000000000000000000000000000000000000;hb=c4ac99630d90770a4e467027420cb4445e721dd3;hpb=afa71a988919e114101e41f0241b08ffc2f436f5

diff --git a/t/lib/IntrospectM2M.pm b/t/lib/IntrospectM2M.pm
new file mode 100644
index 0000000..4852170
--- /dev/null
+++ b/t/lib/IntrospectM2M.pm
@@ -0,0 +1,28 @@
+package IntrospectM2M;
+
+use strict;
+use warnings;
+use base 'DBIx::Class';
+
+__PACKAGE__->mk_classdata( _m2m_metadata => {} );
+
+sub many_to_many {
+  my $class = shift;
+  my ($meth_name, $link, $far_side) = @_;
+  my $store = $class->_m2m_metadata;
+  die "You are overwritting another relationship's metadata"
+    if exists $store->{$meth_name};
+
+  my $attrs = {
+    accessor => $meth_name,
+    relation => $link, #"link" table or immediate relation
+    foreign_relation => $far_side, #'far' table or foreign relation
+    (@_ > 3 ? (attrs => $_[3]) : ()), #only store if exist
+  };
+
+  #inheritable data workaround
+  $class->_m2m_metadata({ $meth_name => $attrs, %$store});
+  $class->next::method(@_);
+}
+
+1;