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   my @qsub_args = ( {}, {
  28     attributes => [qw(
  29       DBIC_method_is_proxy_to_relationship
  30       DBIC_method_is_generated_from_resultsource_metadata
  31     )],
  32   } );
  33
  34   quote_sub "${class}::$_", sprintf( <<'EOC', $rel, $proxy_map{$_} ), @qsub_args
  35     my $self = shift;
  36     my $relobj = $self->%1$s;
  37     if (@_ && !defined $relobj) {
  38       $relobj = $self->create_related( q{%1$s} => { %2$s => $_[0] } );
  39       @_ = ();
  40     }
  41     $relobj ? $relobj->%2$s(@_) : undef;
  42 EOC
  43     for keys %proxy_map
  44 }
  45
  46 sub _build_proxy_map_from {
  47   my ( $class, $proxy_arg ) = @_;
  48   my $ref = ref $proxy_arg;
  49
  50   if ($ref eq 'HASH') {
  51     return %$proxy_arg;
  52   }
  53   elsif ($ref eq 'ARRAY') {
  54     return map {
  55       (ref $_ eq 'HASH')
  56         ? (%$_)
  57         : ($_ => $_)
  58     } @$proxy_arg;
  59   }
  60   elsif ($ref) {
  61     $class->throw_exception("Unable to process the 'proxy' argument $proxy_arg");
  62   }
  63   else {
  64     return ( $proxy_arg => $proxy_arg );
  65   }
  66 }
  67
  68 1;