File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/Afilias/Association.pm
Criterion Covered Total %
statement 12 67 17.9
branch 0 30 0.0
condition 0 9 0.0
subroutine 4 11 36.3
pod 0 7 0.0
total 16 124 12.9


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Afilias Association extension (for .XXX)
2             ##
3             ## Copyright (c) 2010 Patrick Mevzek . All rights reserved.
4             ##
5             ## This file is part of Net::DRI
6             ##
7             ## Net::DRI is free software; you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation; either version 2 of the License, or
10             ## (at your option) any later version.
11             ##
12             ## See the LICENSE file that comes with this distribution for more details.
13             ####################################################################################################
14              
15             package Net::DRI::Protocol::EPP::Extensions::Afilias::Association;
16              
17 1     1   716 use strict;
  1         2  
  1         36  
18 1     1   4 use warnings;
  1         1  
  1         21  
19              
20 1     1   3 use Net::DRI::Util;
  1         0  
  1         17  
21 1     1   3 use Net::DRI::Exception;
  1         2  
  1         555  
22              
23             ####################################################################################################
24              
25             sub register_commands
26             {
27 0     0 0   my ($class,$version)=@_;
28 0           my %tmp=(
29             create => [ \&create, undef ],
30             update => [ \&update, undef ],
31             info => [ undef, \&info_parse ]
32             );
33              
34 0           return { 'domain' => \%tmp };
35             }
36              
37             sub setup
38             {
39 0     0 0   my ($class,$po,$version)=@_;
40 0           $po->ns({association => ['urn:afilias:params:xml:ns:association-1.0','association-1.0.xsd']});
41 0           return;
42             }
43              
44 0     0 0   sub capabilities_add { return ('domain_update','association',['add','del','set']); }
45              
46             ####################################################################################################
47              
48             sub build_association
49             {
50 0     0 0   my $as = shift;
51 0 0         my @pw = defined $as->{'pw'} ? ['association:authInfo',[ 'association:pw',$as->{'pw'}] ] : ();
52             return (
53             ['association:contact',{'type' =>'membership'},
54 0           ['association:id',$as->{'id'}],
55             @pw
56             ]
57             );
58             }
59              
60             sub create
61             {
62 0     0 0   my ($epp,$domain,$rd)=@_;
63 0 0         return unless Net::DRI::Util::has_key($rd,'association');
64 0           my $as=$rd->{association};
65 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('Invalid Association Membership Contact ID and PW') unless Net::DRI::Util::xml_is_token($as->{'id'},1,63) && Net::DRI::Util::xml_is_token($as->{'pw'},6,16);
66 0           my @t = build_association($as);
67 0           my $mes=$epp->message();
68 0           my $eid=$mes->command_extension_register('association','create');
69 0           $mes->command_extension($eid,\@t);
70              
71 0           return;
72             }
73              
74             sub update
75             {
76 0     0 0   my ($epp,$domain,$todo)=@_;
77 0           my $mes=$epp->message();
78 0           my $toadd=$todo->add('association');
79 0           my $todel=$todo->del('association');
80 0           my $tochg=$todo->set('association');
81 0           my @def=grep { defined } ($toadd,$todel);
  0            
82 0 0         return unless @def; ## no updates asked
83              
84 0           my $eid=$mes->command_extension_register('association','update');
85              
86 0           my @n;
87 0 0         if (defined $toadd)
88             {
89 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('Invalid Association Membership Contact ID and PW') unless Net::DRI::Util::xml_is_token($toadd->{'id'},1,63) && Net::DRI::Util::xml_is_token($toadd->{'pw'},6,16);
90 0           push @n,['association:add',build_association($toadd)]
91             }
92 0 0         if (defined $todel)
93             {
94 0           undef $todel->{'pw'};
95 0 0         Net::DRI::Exception::usererr_invalid_parameters('Invalid Association Membership Contact ID') unless Net::DRI::Util::xml_is_token($toadd->{'id'},1,63);
96 0 0         push @n,['association:rem',build_association($todel)] if (defined $todel);
97             }
98 0 0         if (defined $tochg)
99             {
100 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('Invalid Association Membership Contact ID and PW') unless Net::DRI::Util::xml_is_token($tochg->{'id'},1,63) && Net::DRI::Util::xml_is_token($tochg->{'pw'},6,16);
101 0 0         push @n,['association:rem',build_association($tochg)] if (defined $tochg);
102             }
103              
104 0           $mes->command_extension($eid,\@n);
105              
106 0           return;
107             }
108              
109              
110             sub info_parse
111             {
112 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
113 0           my $mes=$po->message();
114 0           my $infdata=$mes->get_extension('association','infData');
115 0 0         return unless defined $infdata;
116              
117 0           my %t;
118 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
119             {
120 0           my ($n,$c)=@$el;
121 0 0         next unless $n eq 'contact';
122 0           $t{'type'} = $c->getAttribute('type');
123 0           foreach my $el2 (Net::DRI::Util::xml_list_children($c))
124             {
125 0           my ($n2,$c2)=@$el2;
126 0 0         $t{$n2}=$c->textContent() if ($n2=~m/^(?:id)$/)
127             }
128             }
129              
130 0           $rinfo->{$otype}->{$oname}->{association}=\%t;
131              
132 0           return;
133             }
134              
135             ####################################################################################################
136             1;