[Bast-commits] r5076 - / DBIx-Class-IntrospectableM2M
DBIx-Class-IntrospectableM2M/trunk
DBIx-Class-IntrospectableM2M/trunk/lib
DBIx-Class-IntrospectableM2M/trunk/lib/DBIx
DBIx-Class-IntrospectableM2M/trunk/lib/DBIx/Class
DBIx-Class-IntrospectableM2M/trunk/t
groditi at dev.catalyst.perl.org
groditi at dev.catalyst.perl.org
Sat Nov 8 19:18:11 GMT 2008
Author: groditi
Date: 2008-11-08 19:18:11 +0000 (Sat, 08 Nov 2008)
New Revision: 5076
Added:
DBIx-Class-IntrospectableM2M/
DBIx-Class-IntrospectableM2M/branches/
DBIx-Class-IntrospectableM2M/tags/
DBIx-Class-IntrospectableM2M/trunk/
DBIx-Class-IntrospectableM2M/trunk/Changes
DBIx-Class-IntrospectableM2M/trunk/Makefile.PL
DBIx-Class-IntrospectableM2M/trunk/README
DBIx-Class-IntrospectableM2M/trunk/lib/
DBIx-Class-IntrospectableM2M/trunk/lib/DBIx/
DBIx-Class-IntrospectableM2M/trunk/lib/DBIx/Class/
DBIx-Class-IntrospectableM2M/trunk/lib/DBIx/Class/IntrospectableM2M.pm
DBIx-Class-IntrospectableM2M/trunk/t/
DBIx-Class-IntrospectableM2M/trunk/t/baisc.t
Log:
new component
Added: DBIx-Class-IntrospectableM2M/trunk/Changes
===================================================================
--- DBIx-Class-IntrospectableM2M/trunk/Changes (rev 0)
+++ DBIx-Class-IntrospectableM2M/trunk/Changes 2008-11-08 19:18:11 UTC (rev 5076)
@@ -0,0 +1,2 @@
+0.001000 November 08, 2008
+ - Initial Release
\ No newline at end of file
Added: DBIx-Class-IntrospectableM2M/trunk/Makefile.PL
===================================================================
--- DBIx-Class-IntrospectableM2M/trunk/Makefile.PL (rev 0)
+++ DBIx-Class-IntrospectableM2M/trunk/Makefile.PL 2008-11-08 19:18:11 UTC (rev 5076)
@@ -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;
Added: DBIx-Class-IntrospectableM2M/trunk/README
===================================================================
--- DBIx-Class-IntrospectableM2M/trunk/README (rev 0)
+++ DBIx-Class-IntrospectableM2M/trunk/README 2008-11-08 19:18:11 UTC (rev 5076)
@@ -0,0 +1,4 @@
+perl Makefile.PL
+make test
+sudo make install
+make clean
\ No newline at end of file
Added: DBIx-Class-IntrospectableM2M/trunk/lib/DBIx/Class/IntrospectableM2M.pm
===================================================================
--- DBIx-Class-IntrospectableM2M/trunk/lib/DBIx/Class/IntrospectableM2M.pm (rev 0)
+++ DBIx-Class-IntrospectableM2M/trunk/lib/DBIx/Class/IntrospectableM2M.pm 2008-11-08 19:18:11 UTC (rev 5076)
@@ -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 at 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
Added: DBIx-Class-IntrospectableM2M/trunk/t/baisc.t
===================================================================
--- DBIx-Class-IntrospectableM2M/trunk/t/baisc.t (rev 0)
+++ DBIx-Class-IntrospectableM2M/trunk/t/baisc.t 2008-11-08 19:18:11 UTC (rev 5076)
@@ -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',
+);
More information about the Bast-commits
mailing list