/usr/share/perl5/DBIx/Class/Relationship/ProxyMethods.pm is in libdbix-class-perl 0.082840-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | package # hide from PAUSE
DBIx::Class::Relationship::ProxyMethods;
use strict;
use warnings;
use base 'DBIx::Class';
use DBIx::Class::_Util 'quote_sub';
use namespace::clean;
our %_pod_inherit_config =
(
class_map => { 'DBIx::Class::Relationship::ProxyMethods' => 'DBIx::Class::Relationship' }
);
sub register_relationship {
my ($class, $rel, $info) = @_;
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_args) = @_;
my %proxy_map = $class->_build_proxy_map_from($proxy_args);
quote_sub "${class}::$_", sprintf( <<'EOC', $rel, $proxy_map{$_} )
my $self = shift;
my $relobj = $self->%1$s;
if (@_ && !defined $relobj) {
$relobj = $self->create_related( %1$s => { %2$s => $_[0] } );
@_ = ();
}
$relobj ? $relobj->%2$s(@_) : undef;
EOC
for keys %proxy_map
}
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;
|