Extend proxy rel attr

The proxy rel attribute can be specified as a hashref and arrayref,
in order to create delegation methods to a related class.

- Test cases for extending proxy rel attr
- Update Relationship::Base docs and Changes file

diff --git a/Changes b/Changes
index b009881..30c9bc7 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for DBIx::Class
 
     * New Features / Changes
+        - Extend 'proxy' relationship attribute
         - Use DBIx::Class::Storage::Debug::PrettyPrint when the
           environment variable DBIC_TRACE_PROFILE is set, see
           DBIx::Class::Storage for more information

diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index ea6f391..6c64754 100644 (file)
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -93,7 +93,11 @@ Explicitly specifies the type of join to use in the relationship. Any SQL
 join type is valid, e.g. C<LEFT> or C<RIGHT>. It will be placed in the SQL
 command immediately before C<JOIN>.
 
-=item proxy
+=item proxy =E<gt> $column | \@columns | \%column
+
+=over 4
+
+=item \@columns
 
 An arrayref containing a list of accessors in the foreign class to create in
 the main class. If, for example, you do the following:
@@ -109,6 +113,25 @@ Then, assuming MyDB::Schema::LinerNotes has an accessor named notes, you can do:
   $cd->notes('Notes go here'); # set notes -- LinerNotes object is
                                # created if it doesn't exist
 
+=item \%column
+
+A hashref where each key is the accessor you want installed in the main class,
+and its value is the name of the original in the fireign class.
+
+  MyDB::Schema::Track->belongs_to( cd => 'DBICTest::Schema::CD', 'cd', {
+      proxy => { cd_title => 'title' },
+  });
+
+This will create an accessor named C<cd_title> on the C<$track> row object.
+
+=back
+
+NOTE: you can pass a nested struct too, for example:
+
+  MyDB::Schema::Track->belongs_to( cd => 'DBICTest::Schema::CD', 'cd', {
+    proxy => [ 'year', { cd_title => 'title' } ],
+  });
+
 =item accessor
 
 Specifies the type of accessor that should be created for the relationship.

diff --git a/lib/DBIx/Class/Relationship/ProxyMethods.pm b/lib/DBIx/Class/Relationship/ProxyMethods.pm
index 7b76499..9623539 100644 (file)
--- a/lib/DBIx/Class/Relationship/ProxyMethods.pm
+++ b/lib/DBIx/Class/Relationship/ProxyMethods.pm
@@ -13,30 +13,53 @@ our %_pod_inherit_config =
 
 sub register_relationship {
   my ($class, $rel, $info) = @_;
-  if (my $proxy_list = $info->{attrs}{proxy}) {
-    $class->proxy_to_related($rel,
-              (ref $proxy_list ? @$proxy_list : $proxy_list));
+  if (my $proxy_args = $info->{attrs}{proxy}) {
+    $class->proxy_to_related($rel, $proxy_args);
   }
   $class->next::method($rel, $info);
 }
 
 sub proxy_to_related {
-  my ($class, $rel, @proxy) = @_;
+  my ($class, $rel, $proxy_args) = @_;
+  my %proxy_map = $class->_build_proxy_map_from($proxy_args);
   no strict 'refs';
   no warnings 'redefine';
-  foreach my $proxy (@proxy) {
-    my $name = join '::', $class, $proxy;
+  foreach my $meth_name ( keys %proxy_map ) {
+    my $proxy_to = $proxy_map{$meth_name};
+    my $name = join '::', $class, $meth_name;
     *$name = Sub::Name::subname $name,
       sub {
         my $self = shift;
         my $val = $self->$rel;
         if (@_ && !defined $val) {
-          $val = $self->create_related($rel, { $proxy => $_[0] });
+          $val = $self->create_related($rel, { $proxy_to => $_[0] });
           @_ = ();
         }
-        return ($val ? $val->$proxy(@_) : undef);
+        return ($val ? $val->$proxy_to(@_) : undef);
      }
   }
 }
 
+sub _build_proxy_map_from {
+  my ( $class, $proxy_arg ) = @_;
+  my $ref = ref $proxy_arg;
+
+  if ($ref eq 'HASH') {
+    return %$proxy_arg;
+  }
+  elsif ($ref eq 'ARRAY') {
+    return map {
+      (ref $_ eq 'HASH')
+        ? (%$_)
+        : ($_ => $_)
+    } @$proxy_arg;
+  }
+  elsif ($ref) {
+    $class->throw_exception("Unable to process the 'proxy' argument $proxy_arg");
+  }
+  else {
+    return ( $proxy_arg => $proxy_arg );
+  }
+}
+
 1;

diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm
index f326bd4..e47b2f9 100644 (file)
--- a/t/lib/DBICTest/Schema.pm
+++ b/t/lib/DBICTest/Schema.pm
@@ -13,8 +13,8 @@ __PACKAGE__->load_classes(qw/
   CD
   FileColumn
   Genre
-  Link
   Bookmark
+  Link
   #dummy
   Track
   Tag

diff --git a/t/lib/DBICTest/Schema/Bookmark.pm b/t/lib/DBICTest/Schema/Bookmark.pm
index 8c2c3b1..50c18d1 100644 (file)
--- a/t/lib/DBICTest/Schema/Bookmark.pm
+++ b/t/lib/DBICTest/Schema/Bookmark.pm
@@ -1,8 +1,7 @@
 package # hide from PAUSE
     DBICTest::Schema::Bookmark;
 
-    use base qw/DBICTest::BaseResult/;
-
+use base qw/DBICTest::BaseResult/;
 
 use strict;
 use warnings;
@@ -20,6 +19,13 @@ __PACKAGE__->add_columns(
 );
 
 __PACKAGE__->set_primary_key('id');
-__PACKAGE__->belongs_to(link => 'DBICTest::Schema::Link', 'link', { on_delete => 'SET NULL' } );
+
+require DBICTest::Schema::Link; # so we can get a columnlist
+__PACKAGE__->belongs_to(
+    link => 'DBICTest::Schema::Link', 'link', {
+    on_delete => 'SET NULL',
+    join_type => 'LEFT',
+    proxy => { map { join('_', 'link', $_) => $_ } DBICTest::Schema::Link->columns },
+});
 
 1;

diff --git a/t/lib/DBICTest/Schema/CD.pm b/t/lib/DBICTest/Schema/CD.pm
index e0fa8fc..552f16e 100644 (file)
--- a/t/lib/DBICTest/Schema/CD.pm
+++ b/t/lib/DBICTest/Schema/CD.pm
@@ -39,6 +39,7 @@ __PACKAGE__->add_unique_constraint([ qw/artist title/ ]);
 
 __PACKAGE__->belongs_to( artist => 'DBICTest::Schema::Artist', undef, { 
     is_deferrable => 1, 
+    proxy => { artist_name => 'name' },
 });
 __PACKAGE__->belongs_to( very_long_artist_relationship => 'DBICTest::Schema::Artist', 'artist', { 
     is_deferrable => 1, 

diff --git a/t/lib/DBICTest/Schema/Tag.pm b/t/lib/DBICTest/Schema/Tag.pm
index 03c8142..35b7587 100644 (file)
--- a/t/lib/DBICTest/Schema/Tag.pm
+++ b/t/lib/DBICTest/Schema/Tag.pm
@@ -28,6 +28,8 @@ __PACKAGE__->add_unique_constraints(  # do not remove, part of a test
   [qw/ tagid tag cd /],
 );
 
-__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD' );
+__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD', 'cd', {
+  proxy => [ 'year', { cd_title => 'title' } ],
+});
 
 1;

diff --git a/t/lib/DBICTest/Schema/Track.pm b/t/lib/DBICTest/Schema/Track.pm
index 12f7296..de3f3c1 100644 (file)
--- a/t/lib/DBICTest/Schema/Track.pm
+++ b/t/lib/DBICTest/Schema/Track.pm
@@ -44,8 +44,12 @@ __PACKAGE__->position_column ('position');
 __PACKAGE__->grouping_column ('cd');
 
 
-__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD' );
-__PACKAGE__->belongs_to( disc => 'DBICTest::Schema::CD' => 'cd');
+__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD', undef, {
+    proxy => { cd_title => 'title' },
+});
+__PACKAGE__->belongs_to( disc => 'DBICTest::Schema::CD' => 'cd', {
+    proxy => 'year'
+});
 
 __PACKAGE__->might_have( cd_single => 'DBICTest::Schema::CD', 'single_track' );
 __PACKAGE__->might_have( lyrics => 'DBICTest::Schema::Lyrics', 'track_id' );

diff --git a/t/relationship/proxy.t b/t/relationship/proxy.t
new file mode 100644 (file)
index 0000000..ec9847d
--- /dev/null
+++ b/t/relationship/proxy.t
@@ -0,0 +1,48 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+my $cd = $schema->resultset('CD')->find(2);
+is($cd->notes, $cd->liner_notes->notes, 'notes proxy ok');
+is($cd->artist_name, $cd->artist->name, 'artist_name proxy ok');
+
+my $track = $cd->tracks->first;
+is($track->cd_title, $track->cd->title, 'cd_title proxy ok');
+is($track->cd_title, $cd->title, 'cd_title proxy II ok');
+is($track->year, $cd->year, 'year proxy ok');
+
+my $tag = $schema->resultset('Tag')->first;
+is($tag->year, $tag->cd->year, 'year proxy II ok');
+is($tag->cd_title, $tag->cd->title, 'cd_title proxy III ok');
+
+my $bookmark = $schema->resultset('Bookmark')->create ({
+  link => { url => 'http://cpan.org', title => 'CPAN' },
+});
+my $link = $bookmark->link;
+ok($bookmark->link_id == $link->id, 'link_id proxy ok');
+is($bookmark->link_url, $link->url, 'link_url proxy ok');
+is($bookmark->link_title, $link->title, 'link_title proxy ok');
+
+my $cd_source_class = $schema->class('CD');
+throws_ok {
+    $cd_source_class->add_relationship('artist_regex',
+        'DBICTest::Schema::Artist', {
+            'foreign.artistid' => 'self.artist'
+        }, { proxy => qr/\w+/ }
+    ) } qr/unable \s to \s process \s the \s \'proxy\' \s argument/ix,
+    'proxy attr with a regex ok';
+throws_ok {
+    $cd_source_class->add_relationship('artist_sub',
+        'DBICTest::Schema::Artist', {
+            'foreign.artistid' => 'self.artist'
+        }, { proxy => sub {} }
+    ) } qr/unable \s to \s process \s the \s \'proxy\' \s argument/ix,
+    'proxy attr with a sub ok';
+
+done_testing;