[Catalyst-commits] r14358 - in CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk: . lib/CatalystX/CRUD/Model lib/CatalystX/CRUD/Object

[karpet at dev.catalyst.perl.org]

Author: karpet
Date: 2012-10-31 03:56:36 +0000 (Wed, 31 Oct 2012)
New Revision: 14358

Modified:
   CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes
   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
Log:
add find_related()

Modified: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes	2012-10-31 03:04:08 UTC (rev 14357)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/Changes	2012-10-31 03:56:36 UTC (rev 14358)
@@ -80,3 +80,5 @@
 0.22    13 June 2009
         * fix tests for UPPERCASE normalize in newer Sort::SQL of ORDER BY string direction
 
+0.23    xxx
+        * add find_related() method

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	2012-10-31 03:04:08 UTC (rev 14357)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Model/RDBO.pm	2012-10-31 03:56:36 UTC (rev 14358)
@@ -8,7 +8,7 @@
 use Carp;
 use Data::Dump qw( dump );
 
-our $VERSION = '0.22';
+our $VERSION = '0.22_01';
 
 __PACKAGE__->mk_ro_accessors(
     qw( name manager treat_like_int load_with related_load_with ));
@@ -340,6 +340,23 @@
     return $obj->$method( $self->_related_query( $obj, $rel ) );
 }
 
+=head2 find_related( I<obj>, I<relationship>, I<foreign_value> )
+
+Implements required method. Returns array or array ref based on calling
+context, for objects related to I<obj> via I<relationship>
+that match I<foreign_value>. I<relationship>
+should be a method name callable on I<obj>.
+
+=cut
+
+sub find_related {
+    my ( $self, $obj, $rel, $foreign_pk_value ) = @_;
+    my $method = 'find_' . $rel;
+    my $meta   = $self->_get_rel_meta( $obj, $rel );
+    my $fpk    = $meta->{map_to}->[1];
+    return $obj->$method( [ $fpk => $foreign_pk_value ] );
+}
+
 =head2 add_related( I<obj>, I<rel_name>, I<foreign_value> )
 
 Associate foreign object identified by I<foreign_value> with I<obj>
@@ -477,8 +494,8 @@
 sub _join_with_table_prefix {
     my ( $self, $q, $prefix ) = @_;
     return join( ', ',
-        map     { $prefix . '.' . $_->[0] . ' ' . $_->[1] }
-            map { [%$_] } @{ $q->{sort_order} } );
+        map { $prefix . '.' . $_->[0] . ' ' . $_->[1] }
+        map { [%$_] } @{ $q->{sort_order} } );
 }
 
 sub make_query {

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	2012-10-31 03:04:08 UTC (rev 14357)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/lib/CatalystX/CRUD/Object/RDBO.pm	2012-10-31 03:56:36 UTC (rev 14358)
@@ -3,7 +3,7 @@
 use warnings;
 use base qw( CatalystX::CRUD::Object );
 
-our $VERSION = '0.22';
+our $VERSION = '0.22_01';
 
 =head1 NAME