new component

diff --git a/Changes b/Changes
new file mode 100644 (file)
index 0000000..0d63c9a
--- /dev/null
+++ b/Changes
@@ -0,0 +1,2 @@
+0.001000 November 08, 2008
+    - Initial Release
\ No newline at end of file

diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..1aad778
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,15 @@
+#! /usr/bin/perl -w
+
+# Load the Module::Install bundled in ./inc/
+use inc::Module::Install;
+
+# Define metadata
+name 'DBIx-Class-IntrospectableM2M';
+abstract 'Introspect many-to-many relationships';
+all_from 'lib/DBIx/Class/IntrospectableM2M.pm';
+
+# Specific dependencie
+requires 'DBIx::Class';
+build_requires 'Test::More';
+
+WriteAll;

diff --git a/README b/README
new file mode 100644 (file)
index 0000000..427ef54
--- /dev/null
+++ b/README
@@ -0,0 +1,4 @@
+perl Makefile.PL
+make test
+sudo make install
+make clean
\ No newline at end of file

diff --git a/lib/DBIx/Class/IntrospectableM2M.pm b/lib/DBIx/Class/IntrospectableM2M.pm
new file mode 100644 (file)
index 0000000..d818c20
--- /dev/null
+++ b/lib/DBIx/Class/IntrospectableM2M.pm
@@ -0,0 +1,98 @@
+package DBIx::Class::IntrospectableM2M;
+
+use strict;
+use warnings;
+use base 'DBIx::Class';
+
+our $VERSION = '0.001000';
+
+#namespace pollution. sadface.
+__PACKAGE__->mk_classdata( _m2m_metadata => {} );
+
+sub many_to_many {
+  my $class = shift;
+  my ($meth_name, $link, $far_side) = @_;
+  my $store = $class->_m2m_metadata;
+  warn("You are overwritting another relationship's metadata")
+    if exists $store->{$meth_name};
+
+  my $attrs = {
+    accessor => $meth_name,
+    relation => $link, #"link" table or imediate relation
+    foreign_relation => $far_side, #'far' table or foreign relation
+    (@_ > 3 ? (attrs => $_[3]) : ()), #only store if exist
+    rs_method => "${meth_name}_rs",      #for completeness..
+    add_method => "add_to_${meth_name}",
+    set_method => "set_${meth_name}",
+    remove_method => "remove_from_${meth_name}",
+  };
+
+  #inheritable data workaround
+  $class->_m2m_metadata({ $meth_name => $attrs, %$store});
+  $class->next::method(@_);
+}
+
+1;
+
+__END__;
+
+=head1 NAME
+
+DBIx::Class::IntrospectableM2M - Introspect many-to-many shortcuts
+
+=head1 SYNOPSIS
+
+In your L<DBIx::Class> Result class
+(sometimes erroneously referred to as the 'table' class):
+
+  __PACKAGE__->load_components(qw/IntrospectableM2M ... Core/);
+
+  #Digest encoder with hex format and SHA-1 algorithm
+  __PACKAGE__->many_to_many(roles => user_roles => 'role);
+
+When you want to introspect this data
+
+   my $metadata = $result_class->_m2m_metadata->{roles};
+   #  $metadata->{accessor} method name e.g. 'roles'
+   #  $metadata->{relation} maping relation e.g. 'user_roles'
+   #  $metadata->{foreign_relation} far-side relation e.g. 'role
+   #  $metadata->{attrs}  relationship attributes, if any
+   # Convenience methods created by DBIx::Class
+   #  $metadata->{rs_method}     'roles_rs'
+   #  $metadata->{add_method}    'add_to_roles',
+   #  $metadata->{set_method}    'set_roles',
+   #  $metadata->{remove_method} 'remove_from_roles'
+
+B<Note:> The component needs to be loaded I<before> Core.
+
+=head1 DESCRIPTION
+
+Because the many-to-many relationships are not real relationships, they can not
+be introspected with DBIx::Class. Many-to-many relationships are actually just
+a collection of convenience methods installed to bridge two relationships.
+This L<DBIx::Class> component can be used to store all relevant information
+about these non-relationships so they can later be introspected and examined.
+
+=head1 METHODS
+
+=head2 many_to_many
+
+Extended to store all relevant information in the C<_m2m_metadata> HASH ref.
+
+=head2 _m2m_metadata
+
+Accessor to a HASH ref where the keys are the names of m2m relationships and
+the value is a HASH ref as described in the SYNOPSIS.
+
+=head1 AUTHOR
+
+Guillermo Roditi (groditi) E<lt>groditi@cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2008 by Guillermo Roditi
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut

diff --git a/t/baisc.t b/t/baisc.t
new file mode 100644 (file)
index 0000000..6911221
--- /dev/null
+++ b/t/baisc.t
@@ -0,0 +1,68 @@
+#/usr/local/bin/perl -w
+
+{
+  package TestIntrospectableM2M::FooBar;
+  
+  use strict;
+  use warnings;
+  use base 'DBIx::Class::Core';
+
+  __PACKAGE__->table('foobar');
+  __PACKAGE__->add_columns(
+    fooid => {data_type => 'integer'},
+    barid => {data_type => 'integer'},
+  );
+  __PACKAGE__->set_primary_key(qw/fooid barid/);
+  __PACKAGE__->belongs_to(foo => 'TestIntrospectableM2M::Foo', { 'foreign.id' => 'self.fooid' },);
+  __PACKAGE__->belongs_to(bar => 'TestIntrospectableM2M::Bar', { 'foreign.id' => 'self.barid' },);
+
+  package TestIntrospectableM2M::Foo;
+  
+  use strict;
+  use warnings;
+  use base 'DBIx::Class';
+
+  __PACKAGE__->load_components(qw/IntrospectableM2M Core/);
+  __PACKAGE__->table('foo');
+  __PACKAGE__->add_columns( id => {data_type => 'integer'} );
+  __PACKAGE__->has_many(foobars => 'TestIntrospectableM2M::FooBar', { 'foreign.fooid' => 'self.id' },);
+  __PACKAGE__->many_to_many(bars => foobars => 'bar');
+
+  package TestIntrospectableM2M::Bar;
+  
+  use strict;
+  use warnings;
+  use base 'DBIx::Class';
+
+  __PACKAGE__->load_components(qw/IntrospectableM2M Core/);
+  __PACKAGE__->table('bar');
+  __PACKAGE__->add_columns( id => {data_type => 'integer'} );
+  __PACKAGE__->has_many(foobars => 'TestIntrospectableM2M::FooBar', { 'foreign.barid' => 'self.id' },);
+  __PACKAGE__->many_to_many(foos => foobars => 'foo');
+}
+
+package main;
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+my $metadata = TestIntrospectableM2M::Bar->_m2m_metadata;
+
+is(scalar(keys(%$metadata)), 1, 'number of keys');
+
+is_deeply( [keys(%$metadata)], ['foos'], 'correct keys');
+
+is_deeply(
+  $metadata->{foos},
+  {
+    accessor => 'foos',
+    relation => 'foobars',
+    foreign_relation => 'foo',
+    rs_method => "foos_rs",
+    add_method => "add_to_foos",
+    set_method => "set_foos",
+    remove_method => "remove_from_foos",
+  },
+  'metadata hash correct',
+);