[Catalyst-commits] r8241 - in CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk: lib/CatalystX/CRUD/ModelAdapter t t/MyDB t/MyDB/Main

karpet at dev.catalyst.perl.org karpet at dev.catalyst.perl.org
Thu Aug 21 11:44:08 BST 2008


Author: karpet
Date: 2008-08-21 11:44:08 +0100 (Thu, 21 Aug 2008)
New Revision: 8241

Added:
   CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/CdTrackJoin.pm
Modified:
   CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/CatalystX/CRUD/ModelAdapter/DBIC.pm
   CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/01-dbic.t
   CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main.pm
   CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Artist.pm
   CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Cd.pm
   CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Track.pm
   CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/insertdb.pl
Log:
implement add_related and rm_related methods

Modified: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/CatalystX/CRUD/ModelAdapter/DBIC.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/CatalystX/CRUD/ModelAdapter/DBIC.pm	2008-08-21 05:53:48 UTC (rev 8240)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/lib/CatalystX/CRUD/ModelAdapter/DBIC.pm	2008-08-21 10:44:08 UTC (rev 8241)
@@ -4,6 +4,8 @@
 use base qw( CatalystX::CRUD::ModelAdapter CatalystX::CRUD::Model::Utils );
 use Class::C3;
 use Scalar::Util qw( weaken );
+use Carp;
+use Data::Dump qw( dump );
 
 our $VERSION = '0.03';
 
@@ -213,6 +215,131 @@
     return $obj->$rel->count(@q);
 }
 
+=head2 add_related( I<controller>, I<context>, I<obj>, I<rel_name>, I<foreign_value> )
+
+Implements optional method as defined by core API. I<rel_name>
+should be a method name callable by I<obj>.
+
+=cut
+
+sub add_related {
+    my ( $self, $controller, $c, $obj, $rel, $for_val ) = @_;
+    my $rinfo = $self->_get_rel_meta( $controller, $c, $obj, $rel );
+
+    #carp dump $rinfo;
+    if ( !exists $rinfo->{class} ) {
+
+        # isa m2m
+        # must find the foreign object to pass to add_to_$rel()
+        my $for_obj
+            = $self->_get_m2m_foreign_object( $controller, $c, $obj, $rinfo,
+            $for_val );
+        my $add_method = $rinfo->{add_method};
+        $obj->$add_method($for_obj);
+    }
+    else {
+        croak "TODO o2m";
+    }
+}
+
+sub _get_m2m_foreign_object {
+    my ( $self, $controller, $c, $obj, $rinfo, $for_val ) = @_;
+    my $o2m_rel = $rinfo->{relation};
+    my $o2m_rinfo = $self->_get_rel_meta( $controller, $c, $obj, $o2m_rel );
+
+    #carp dump $o2m_rinfo;
+
+    my $map_class = $o2m_rinfo->{class};
+    my ( $for_class, $for_pk );
+    for my $for_rel ( $map_class->relationships ) {
+        my $for_rel_info = $map_class->relationship_info($for_rel);
+
+        #carp "for_rel: " . dump $for_rel_info;
+
+        # this is a FK in the map table but which one?
+        # we want the other side
+        if ( !$obj->isa( $for_rel_info->{class} ) ) {
+            $for_class = $for_rel_info->{class};
+            ($for_pk) = $for_class->primary_columns;    # TODO multiple?
+        }
+
+    }
+
+    #carp "for_class = $for_class";
+    #carp "for_pk    = $for_pk";
+
+    my $for_obj
+        = $c->model( $self->model_name )->resultset($for_class)
+        ->find( { $for_pk => $for_val } )
+        or $self->throw_error(
+        "can't add foreign object in $for_class for $for_val");
+
+    return $for_obj;
+}
+
+=head2 rm_related( I<controller>, I<context>, I<obj>, I<rel_name>, I<foreign_value> )
+
+Implements optional method as defined by core API. I<rel_name>
+should be a method name callable by I<obj>.
+
+=cut
+
+sub rm_related {
+    my ( $self, $controller, $c, $obj, $rel, $for_val ) = @_;
+    my $rinfo = $self->_get_rel_meta( $controller, $c, $obj, $rel );
+
+    #carp dump $rinfo;
+    if ( !exists $rinfo->{class} ) {
+
+        # isa m2m
+        # must find the foreign object to pass to remove_from_$rel()
+        my $for_obj
+            = $self->_get_m2m_foreign_object( $controller, $c, $obj, $rinfo,
+            $for_val );
+        my $rm_method = $rinfo->{remove_method};
+        $obj->$rm_method($for_obj);
+
+    }
+    else {
+        croak "TODO o2m";
+    }
+
+}
+
+=head2 has_relationship( I<controller>, I<context>, I<obj>, I<rel_name> )
+
+Implements optional method as defined by core API. I<rel_name>
+should be a method name callable by I<obj>.
+
+=cut
+
+sub has_relationship {
+    my ( $self, $controller, $c, $obj, $rel ) = @_;
+    if ( !$obj->can('_m2m_metadata') ) {
+        $self->throw_error(
+            "DBIx::Class::IntrospectableM2M not loaded for $obj");
+    }
+
+    #carp dump $obj;
+    #carp dump $obj->_m2m_metadata;
+
+    return $obj->_m2m_metadata->{$rel} if exists $obj->_m2m_metadata->{$rel};
+    for ( $obj->relationships ) {
+        return $obj->relationship_info($_)
+            if $_ eq $rel;    # has_relationship() does not work??
+    }
+    return;
+}
+
+sub _get_rel_meta {
+    my ( $self, $controller, $c, $obj, $rel ) = @_;
+    if ( !$self->has_relationship( $controller, $c, $obj, $rel ) ) {
+        $self->throw_error("no such relationship $rel defined for $obj");
+    }
+    return $self->has_relationship( $controller, $c, $obj, $rel )
+        || $obj->relationship_info($rel);
+}
+
 sub _get_field_names {
     my $self       = shift;
     my $controller = shift;

Modified: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/01-dbic.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/01-dbic.t	2008-08-21 05:53:48 UTC (rev 8240)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/01-dbic.t	2008-08-21 10:44:08 UTC (rev 8241)
@@ -1,7 +1,10 @@
-use Test::More tests => 13;
+use Test::More tests => 17;
 
 BEGIN {
     use lib qw( ../../CatalystX-CRUD/trunk/lib t );
+
+    $ENV{CATALYST_DEBUG} = $ENV{PERL_DEBUG} || 0;
+
     use_ok('CatalystX::CRUD::ModelAdapter::DBIC');
 
     system("cd t/ && $^X insertdb.pl") and die "can't create db: $!";
@@ -49,3 +52,25 @@
     '{ cd => 3, title => "Something New, Something Blue", trackid => 8 }',
     "POST new track"
 );
+
+# test *_related features
+
+ok( $res = request(
+        POST( '/crud/3/related/cds/1/add', [] ),
+        "/crud/3/related/multitracks/1/add"
+    )
+);
+
+is( $res->headers->{status}, 200, "POST returned OK" );
+
+#dump $res;
+
+ok( $res = request(
+        POST( '/crud/3/related/cds/1/remove', [] ),
+        "/crud/3/related/multitracks/1/remove"
+    )
+);
+
+is( $res->headers->{status}, 200, "POST returned OK" );
+
+#dump $res;

Modified: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Artist.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Artist.pm	2008-08-21 05:53:48 UTC (rev 8240)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Artist.pm	2008-08-21 10:44:08 UTC (rev 8241)
@@ -1,6 +1,6 @@
 package MyDB::Main::Artist;
 use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+__PACKAGE__->load_components(qw/IntrospectableM2M Core/);
 __PACKAGE__->table('artist');
 __PACKAGE__->add_columns(qw/ artistid name /);
 __PACKAGE__->set_primary_key('artistid');

Modified: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Cd.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Cd.pm	2008-08-21 05:53:48 UTC (rev 8240)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Cd.pm	2008-08-21 10:44:08 UTC (rev 8241)
@@ -1,10 +1,18 @@
 package MyDB::Main::Cd;
 use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+__PACKAGE__->load_components(qw/IntrospectableM2M Core/);
 __PACKAGE__->table('cd');
 __PACKAGE__->add_columns(qw/ cdid artist title/);
 __PACKAGE__->set_primary_key('cdid');
 __PACKAGE__->belongs_to( 'artist' => 'MyDB::Main::Artist' );
 __PACKAGE__->has_many( 'tracks' => 'MyDB::Main::Track' );
+__PACKAGE__->has_many(
+    'cd_tracks' => 'MyDB::Main::CdTrackJoin',
+    'cdid'
+);
+__PACKAGE__->many_to_many(
+    'multitracks' => 'cd_tracks',
+    'trackid'
+);
 
 1;

Added: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/CdTrackJoin.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/CdTrackJoin.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/CdTrackJoin.pm	2008-08-21 10:44:08 UTC (rev 8241)
@@ -0,0 +1,10 @@
+package MyDB::Main::CdTrackJoin;
+use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/ IntrospectableM2M Core /);
+__PACKAGE__->table('cd_track_join');
+__PACKAGE__->add_columns(qw/ trackid cdid id /);
+__PACKAGE__->set_primary_key('id');
+__PACKAGE__->belongs_to( 'cdid'    => 'MyDB::Main::Cd' );
+__PACKAGE__->belongs_to( 'trackid' => 'MyDB::Main::Track' );
+
+1;

Modified: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Track.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Track.pm	2008-08-21 05:53:48 UTC (rev 8240)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main/Track.pm	2008-08-21 10:44:08 UTC (rev 8241)
@@ -1,9 +1,17 @@
 package MyDB::Main::Track;
 use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+__PACKAGE__->load_components(qw/IntrospectableM2M Core/);
 __PACKAGE__->table('track');
 __PACKAGE__->add_columns(qw/ trackid cd title/);
 __PACKAGE__->set_primary_key('trackid');
 __PACKAGE__->belongs_to( 'cd' => 'MyDB::Main::Cd' );
+__PACKAGE__->has_many(
+    'cd_tracks' => 'MyDB::Main::CdTrackJoin',
+    'trackid'
+);
+__PACKAGE__->many_to_many(
+    'cds' => 'cd_tracks',
+    'cdid'
+);
 
 1;

Modified: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main.pm	2008-08-21 05:53:48 UTC (rev 8240)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/MyDB/Main.pm	2008-08-21 10:44:08 UTC (rev 8241)
@@ -1,5 +1,5 @@
 package MyDB::Main;
 use base qw/DBIx::Class::Schema/;
-__PACKAGE__->load_classes(qw/Artist Cd Track/);
+__PACKAGE__->load_classes();
 
 1;

Modified: CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/insertdb.pl
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/insertdb.pl	2008-08-21 05:53:48 UTC (rev 8240)
+++ CatalystX-CRUD/CatalystX-CRUD-ModelAdapter-DBIC/trunk/t/insertdb.pl	2008-08-21 10:44:08 UTC (rev 8241)
@@ -34,6 +34,16 @@
 }
 ) or die;
 
+$dbh->do(
+    qq{
+CREATE TABLE cd_track_join (
+    id          INTEGER PRIMARY KEY AUTOINCREMENT,
+    cdid        INTEGER NOT NULL REFERENCES cd(cdid),
+    trackid     INTEGER NOT NULL REFERENCES track(trackid)
+ );
+}
+) or die;
+
 #  here's some of the sql that is going to be generated by the schema
 #  INSERT INTO artist VALUES (NULL,'Michael Jackson');
 #  INSERT INTO artist VALUES (NULL,'Eminem');




More information about the Catalyst-commits mailing list