lib/DBIx/Class/Relationship/ProxyMethods.pm

   1 package # hide from PAUSE
   2     DBIx::Class::Relationship::ProxyMethods;
   3
   4 use strict;
   5 use warnings;
   6 use base 'DBIx::Class';
   7 use DBIx::Class::_Util 'quote_sub';
   8 use namespace::clean;
   9
  10 our %_pod_inherit_config =
  11   (
  12    class_map => { 'DBIx::Class::Relationship::ProxyMethods' => 'DBIx::Class::Relationship' }
  13   );
  14
  15 sub register_relationship {
  16   my ($class, $rel, $info) = @_;
  17   if (my $proxy_args = $info->{attrs}{proxy}) {
  18     $class->proxy_to_related($rel, $proxy_args);
  19   }
  20   $class->next::method($rel, $info);
  21 }
  22
  23 sub proxy_to_related {
  24   my ($class, $rel, $proxy_args) = @_;
  25   my %proxy_map = $class->_build_proxy_map_from($proxy_args);
  26
  27   quote_sub "${class}::$_", sprintf( <<'EOC', $rel, $proxy_map{$_} )
  28     my $self = shift;
  29     my $relobj = $self->%1$s;
  30     if (@_ && !defined $relobj) {
  31       $relobj = $self->create_related( q{%1$s} => { %2$s => $_[0] } );
  32       @_ = ();
  33     }
  34     $relobj ? $relobj->%2$s(@_) : undef;
  35 EOC
  36     for keys %proxy_map
  37 }
  38
  39 sub _build_proxy_map_from {
  40   my ( $class, $proxy_arg ) = @_;
  41   my $ref = ref $proxy_arg;
  42
  43   if ($ref eq 'HASH') {
  44     return %$proxy_arg;
  45   }
  46   elsif ($ref eq 'ARRAY') {
  47     return map {
  48       (ref $_ eq 'HASH')
  49         ? (%$_)
  50         : ($_ => $_)
  51     } @$proxy_arg;
  52   }
  53   elsif ($ref) {
  54     $class->throw_exception("Unable to process the 'proxy' argument $proxy_arg");
  55   }
  56   else {
  57     return ( $proxy_arg => $proxy_arg );
  58   }
  59 }
  60
  61 1;