[Catalyst-commits] r8238 - in
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk: .
lib/CatalystX/CRUD/Model lib/CatalystX/CRUD/Object t t/lib t/lib/My
karpet at dev.catalyst.perl.org
karpet at dev.catalyst.perl.org
Thu Aug 21 06:52:23 BST 2008
Author: karpet
Date: 2008-08-21 06:52:23 +0100 (Thu, 21 Aug 2008)
New Revision: 8238
Modified:
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Makefile.PL
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Model/RDBO.pm
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Object/RDBO.pm
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/01-rdbo.t
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Foo.pm
CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp.pm
Log:
add support for new relationship api
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes 2008-08-21 05:52:10 UTC (rev 8237)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes 2008-08-21 05:52:23 UTC (rev 8238)
@@ -42,3 +42,8 @@
* add ::Manager::Debug to debugging option
* add 'boolean' to _treat_like_int match
+0.13 xx
+ * support new *_related methods in core API
+
+
+
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Makefile.PL
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Makefile.PL 2008-08-21 05:52:10 UTC (rev 8237)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Makefile.PL 2008-08-21 05:52:23 UTC (rev 8238)
@@ -12,6 +12,7 @@
'Test::More' => 0,
'Data::Dump' => 0, # for testing
'Rose::DB::Object' => 0,
+ 'Rose::DBx::Object::MoreHelpers' => 0,
'CatalystX::CRUD' => 0.18,
'Catalyst::Runtime' => 0,
'Rose::DBx::TestDB' => 0,
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Model/RDBO.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Model/RDBO.pm 2008-08-21 05:52:10 UTC (rev 8237)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Model/RDBO.pm 2008-08-21 05:52:23 UTC (rev 8238)
@@ -4,8 +4,10 @@
use base qw( CatalystX::CRUD::Model CatalystX::CRUD::Model::Utils );
use CatalystX::CRUD::Iterator;
use Class::C3;
+use Carp;
+use Data::Dump qw( dump );
-our $VERSION = '0.12';
+our $VERSION = '0.13';
__PACKAGE__->mk_ro_accessors(qw( name manager treat_like_int ));
__PACKAGE__->config->{object_class} = 'CatalystX::CRUD::Object::RDBO';
@@ -254,6 +256,105 @@
return CatalystX::CRUD::Iterator->new( $iter, $self->object_class );
}
+=head2 search_related( I<obj>, I<relationship> )
+
+Implements required method. Returns array or array ref based on calling
+context, for objects related to I<obj> via I<relationship>. I<relationship>
+should be a method name callable on I<obj>.
+
+=head2 iterator_related( I<obj>, I<relationship> )
+
+Like search_related() but returns an iterator.
+
+=head2 count_related( I<obj>, I<relationship> )
+
+Like search_related() but returns an integer.
+
+=cut
+
+sub search_related {
+ my ( $self, $obj, $rel ) = @_;
+ return $obj->$rel;
+}
+
+sub iterator_related {
+ my ( $self, $obj, $rel ) = @_;
+ my $method = $rel . '_iterator';
+ return $obj->$method;
+}
+
+sub count_related {
+ my ( $self, $obj, $rel ) = @_;
+ my $method = $rel . '_count';
+ return $obj->$method;
+}
+
+=head2 add_related( I<obj>, I<rel_name>, I<foreign_value> )
+
+Associate foreign object identified by I<foreign_value> with I<obj>
+via the relationship I<rel_name>.
+
+B<CAUTION:> For many-to-many relationships only.
+
+=head2 rm_related( I<obj>, I<rel_name>, I<foreign_value> )
+
+Dissociate foreign object identified by I<foreign_value> from I<obj>
+via the relationship I<rel_name>.
+
+B<CAUTION:> For many-to-many relationships only.
+
+=cut
+
+sub _get_rel_meta {
+ my ( $self, $obj, $rel_name ) = @_;
+
+ my $rel = $obj->meta->relationship($rel_name)
+ or $self->throw_error("no such relationship $rel_name");
+
+ my $map_class = $rel->map_class;
+ my $mcm = $map_class->meta;
+ my @map_to = $mcm->relationship( $rel->map_to )->column_map;
+ my @map_from = $mcm->relationship( $rel->map_from )->column_map;
+ my %m = (
+ map_to => \@map_to,
+ map_from => \@map_from,
+ map_class => $map_class,
+ );
+
+ #carp dump \%m;
+
+ return \%m;
+}
+
+sub add_related {
+ my ( $self, $obj, $rel_name, $fk_val ) = @_;
+ my $addmethod = 'add_' . $rel_name;
+ my $meta = $self->_get_rel_meta( $obj, $rel_name );
+ $obj->$addmethod( { $meta->{map_to}->[1] => $fk_val } );
+ $obj->save;
+}
+
+sub rm_related {
+ my ( $self, $obj, $rel_name, $fk_val ) = @_;
+
+ my $meta = $self->_get_rel_meta( $obj, $rel_name );
+ my $obj_method
+ = $obj->meta->column_accessor_method_name( $meta->{map_from}->[1] );
+ my $query = [
+ $meta->{map_from}->[0] => $obj->$obj_method,
+ $meta->{map_to}->[0] => $fk_val,
+ ];
+
+ #carp dump $query;
+
+ $self->manager->delete_objects(
+ object_class => $meta->{map_class},
+ where => $query,
+ );
+ $obj->forget_related($rel_name);
+ return $obj;
+}
+
=head2 make_query( I<field_names> )
Implement a RDBO-specific query factory based on request parameters.
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Object/RDBO.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Object/RDBO.pm 2008-08-21 05:52:10 UTC (rev 8237)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Object/RDBO.pm 2008-08-21 05:52:23 UTC (rev 8238)
@@ -3,7 +3,7 @@
use warnings;
use base qw( CatalystX::CRUD::Object );
-our $VERSION = '0.12';
+our $VERSION = '0.13';
=head1 NAME
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/01-rdbo.t
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/01-rdbo.t 2008-08-21 05:52:10 UTC (rev 8237)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/01-rdbo.t 2008-08-21 05:52:23 UTC (rev 8238)
@@ -1,7 +1,8 @@
-use Test::More tests => 5;
+use Test::More tests => 14;
BEGIN {
- use lib qw( ../CatalystX-CRUD/lib );
+ $ENV{CATALYST_DEBUG} = $ENV{PERL_DEBUG} || 0;
+ use lib qw( ../../CatalystX-CRUD/trunk/lib );
use_ok('CatalystX::CRUD::Model::RDBO');
use_ok('CatalystX::CRUD::Object::RDBO');
use_ok('Rose::DBx::TestDB');
@@ -11,6 +12,32 @@
use lib qw( t/lib );
use Catalyst::Test 'MyApp';
use Data::Dump qw( dump );
+use HTTP::Request::Common;
-ok( get('/foo'), "get /foo" );
+ok( my $res = request('/foo/test'), "get /foo/test" );
+#dump $res->headers;
+
+is( $res->headers->{status}, 200, "get 200" );
+
+ok( $res = request('/foo/1/read'), "get /foo/1/read" );
+
+is( $res->headers->{status}, 200, "get 200" );
+
+ok( $res = request('/foo/1/related/bars/2/add'),
+ "GET /foo/1/related/bars/2/add" );
+
+is( $res->headers->{status}, 500, "cannot GET add related" );
+
+# add a new foobar
+ok( $res = request( POST( '/foo/1/related/bars/2/add', [] ) ),
+ "POST /foo/1/related/bars/2/add" );
+
+is( $res->headers->{status}, 200, "POST add related OK" );
+
+# remove an old foobar
+ok( $res = request( POST( '/foo/1/related/bars/1/remove', [] ) ),
+ "POST /foo/1/related/bars/1/remove" );
+
+is( $res->headers->{status}, 200, "POST remove related OK" );
+
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Foo.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Foo.pm 2008-08-21 05:52:10 UTC (rev 8237)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Foo.pm 2008-08-21 05:52:23 UTC (rev 8238)
@@ -1,43 +1,39 @@
package My::Foo;
-use base qw( Rose::DB::Object );
+use strict;
+use base qw(
+ Rose::DB::Object
+ Rose::DB::Object::Helpers
+ Rose::DBx::Object::MoreHelpers
+);
use Carp;
use Data::Dump qw( dump );
+use My::DB;
-# create a temp db
-my $db = Rose::DBx::TestDB->new;
-
-{
- my $dbh = $db->dbh;
-
- # create a schema to match this class
- $dbh->do(
- "create table foos ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(16) );"
- );
-
- # create some data
- $dbh->do("insert into foos (name) values ('bar');");
-
- # double check
- my $sth = $dbh->prepare("SELECT * FROM foos");
- $sth->execute;
- croak "bad seed data in sqlite"
- unless $sth->fetchall_arrayref->[0]->[0] == 1;
-
- $sth = undef; # http://rt.cpan.org/Ticket/Display.html?id=22688
- # does not seem to work.
-
-}
-
__PACKAGE__->meta->setup(
table => 'foos',
columns => [
id => { type => 'serial', not_null => 1, primary_key => 1 },
name => { type => 'varchar', length => 16 },
],
+
+ primary_key_columns => ['id'],
+
+ relationships => [
+ bar => {
+ class => 'My::FooBar',
+ column_map => { id => 'foo_id' },
+ type => 'one to many',
+ },
+
+ bars => {
+ map_class => 'My::FooBar',
+ type => 'many to many',
+ }
+ ],
);
sub init_db {
- return $db;
+ return My::DB->new;
}
1;
Modified: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp.pm 2008-08-21 05:52:10 UTC (rev 8237)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp.pm 2008-08-21 05:52:23 UTC (rev 8238)
@@ -7,23 +7,4 @@
__PACKAGE__->setup();
-sub foo : Local {
-
- my ( $self, $c, @arg ) = @_;
-
- my $thing = $c->model('Foo')->new_object( id => 1 );
-
- for my $m (qw( create read update delete)) {
- croak unless $thing->can($m);
- }
-
- # try fetching our seed data
- $thing->read();
-
- croak "bad read" unless ( $thing->delegate->name eq 'bar' );
-
- $c->res->body("foo is a-ok");
-
-}
-
1;
More information about the Catalyst-commits
mailing list