File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/BR/Contact.pm
Criterion Covered Total %
statement 18 155 11.6
branch 0 90 0.0
condition 0 23 0.0
subroutine 6 16 37.5
pod 0 10 0.0
total 24 294 8.1


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .BR Contact EPP extension commands
2             ## draft-neves-epp-brorg-03.txt
3             ##
4             ## Copyright (c) 2008,2013 Patrick Mevzek . All rights reserved.
5             ##
6             ## This file is part of Net::DRI
7             ##
8             ## Net::DRI is free software; you can redistribute it and/or modify
9             ## it under the terms of the GNU General Public License as published by
10             ## the Free Software Foundation; either version 2 of the License, or
11             ## (at your option) any later version.
12             ##
13             ## See the LICENSE file that comes with this distribution for more details.
14             ####################################################################################################
15              
16             package Net::DRI::Protocol::EPP::Extensions::BR::Contact;
17              
18 1     1   1415 use strict;
  1         1  
  1         27  
19 1     1   4 use warnings;
  1         1  
  1         22  
20              
21 1     1   5 use Net::DRI::Exception;
  1         2  
  1         15  
22 1     1   3 use Net::DRI::Util;
  1         1  
  1         20  
23 1     1   4 use Net::DRI::Data::ContactSet;
  1         1  
  1         21  
24 1     1   3 use Net::DRI::Data::Contact::BR;
  1         2  
  1         16  
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Protocol::EPP::Extensions::BR::Contact - .BR EPP Contact extension commands for Net::DRI
31              
32             =head1 DESCRIPTION
33              
34             Please see the README file for details.
35              
36             =head1 SUPPORT
37              
38             For now, support questions should be sent to:
39              
40             Enetdri@dotandco.comE
41              
42             Please also see the SUPPORT file in the distribution.
43              
44             =head1 SEE ALSO
45              
46             Ehttp://www.dotandco.com/services/software/Net-DRI/E
47              
48             =head1 AUTHOR
49              
50             Patrick Mevzek, Enetdri@dotandco.comE
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2008,2013 Patrick Mevzek .
55             All rights reserved.
56              
57             This program is free software; you can redistribute it and/or modify
58             it under the terms of the GNU General Public License as published by
59             the Free Software Foundation; either version 2 of the License, or
60             (at your option) any later version.
61              
62             See the LICENSE file that comes with this distribution for more details.
63              
64             =cut
65              
66             ####################################################################################################
67              
68             sub register_commands
69             {
70 0     0 0   my ($class,$version)=@_;
71 0           my %tmp=(
72             check => [ \&check, \&check_parse ],
73             info => [ \&info, \&info_parse ],
74             create => [ \&create, undef ],
75             update => [ \&update, undef ],
76             review_complete => [ undef, \&pandata_parse ],
77             );
78              
79 0           $tmp{check_multi}=$tmp{check};
80 0           return { 'contact' => \%tmp };
81             }
82              
83             ####################################################################################################
84              
85             sub build_command_extension
86             {
87 0     0 0   my ($mes,$epp,$tag)=@_;
88 0           return $mes->command_extension_register($tag,sprintf('xmlns:brorg="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('brorg')));
89             }
90              
91             sub check
92             {
93 0     0 0   my ($epp,$contact,$rd)=@_;
94 0           my $mes=$epp->message();
95              
96 0           my $eid=build_command_extension($mes,$epp,'brorg:check');
97 0           my @n;
98 0 0         foreach my $c ((ref($contact) eq 'ARRAY')? @$contact : ($contact))
99             {
100 0 0         Net::DRI::Exception::usererr_invalid_parameters('contact must be Net::DRI::Data::Contact::BR object') unless Net::DRI::Util::isa_contact($c,'Net::DRI::Data::Contact::BR');
101 0           my $orgid=$c->orgid();
102 0 0         if (defined($orgid))
103             {
104 0 0         Net::DRI::Exception::usererr_invalid_parameters('orgid must be an xml token string with 1 to 30 characters') unless Net::DRI::Util::xml_is_token($orgid,1,30);
105 0           push @n,['brorg:cd',['brorg:id',$c->srid()],['brorg:organization',$orgid]];
106             } else
107             {
108 0           push @n,['brorg:cd',['brorg:id',$c->srid()]];
109             }
110             }
111 0           $mes->command_extension($eid,\@n);
112 0           return;
113             }
114              
115             sub check_parse
116             {
117 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
118 0           my $mes=$po->message();
119 0 0         return unless $mes->is_success();
120              
121 0           my $chkdata=$mes->get_extension('brorg','chkData');
122 0 0         return unless $chkdata;
123              
124 0           foreach my $cd ($chkdata->getChildrenByTagNameNS($mes->ns('brorg'),'ticketInfo'))
125             {
126 0           my $c=$cd->getFirstChild();
127 0           my ($orgid,$ticket,$domain);
128 0           while($c)
129             {
130 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
131 0   0       my $n=$c->localname() || $c->nodeName();
132 0 0         if ($n eq 'organization')
    0          
    0          
133             {
134 0           $orgid=$c->getFirstChild()->getData();
135             } elsif ($n eq 'ticketNumber')
136             {
137 0           $ticket=$c->getFirstChild()->getData();
138             } elsif ($n eq 'domainName')
139             {
140 0           $domain=$c->getFirstChild()->getData();
141             }
142 0           } continue { $c=$c->getNextSibling(); }
143              
144 0           $rinfo->{orgid}->{$orgid}->{ticket}=$ticket;
145 0           $rinfo->{orgid}->{$orgid}->{domain}=$domain;
146 0           $rinfo->{domain}->{$domain}->{ticket}=$ticket;
147 0           $rinfo->{domain}->{$domain}->{orgid}=$orgid;
148             }
149 0           return;
150             }
151              
152             sub info
153             {
154 0     0 0   my ($epp,$contact,$rd)=@_;
155 0           my $mes=$epp->message();
156              
157 0 0         Net::DRI::Exception::usererr_invalid_parameters('contact must be Net::DRI::Data::Contact::BR object') unless Net::DRI::Util::isa_contact($contact,'Net::DRI::Data::Contact::BR');
158 0           my $orgid=$contact->orgid();
159 0 0         return unless defined($orgid); ## to be able to create pure contacts
160 0 0         Net::DRI::Exception::usererr_invalid_parameters('orgid must be an xml token string with 1 to 30 characters') unless Net::DRI::Util::xml_is_token($orgid,1,30);
161              
162 0           my $eid=build_command_extension($mes,$epp,'brorg:info');
163 0           my @n=(['brorg:organization',$orgid]);
164 0           $mes->command_extension($eid,\@n);
165 0           return;
166             }
167              
168             sub info_parse
169             {
170 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
171 0           my $mes=$po->message();
172 0 0         return unless $mes->is_success();
173              
174 0           my $infdata=$mes->get_extension('brorg','infData');
175 0 0         return unless $infdata;
176              
177 0           my $id=(keys(%{$rinfo->{contact}}))[0];
  0            
178 0           my $co=$rinfo->{contact}->{$id}->{self};
179 0           my $cs=Net::DRI::Data::ContactSet->new();
180 0           my ($orgid,@d);
181 0           my $c=$infdata->getFirstChild();
182 0           while($c)
183             {
184 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
185 0   0       my $n=$c->localname() || $c->nodeName();
186 0 0         if ($n eq 'organization')
    0          
    0          
    0          
    0          
187             {
188 0           $orgid=$c->getFirstChild()->getData();
189 0           $co->orgid($orgid);
190 0           $rinfo->{contact}->{$id}->{orgid}=$orgid;
191             } elsif ($n eq 'contact')
192             {
193 0           my $co=Net::DRI::Data::Contact::BR->new();
194 0           $co->srid($c->getFirstChild()->getData());
195 0           $co->orgid($orgid);
196 0           my $type=$c->getAttribute('type');
197 0           $co->type($type);
198 0           $cs->add($co,$type);
199             } elsif ($n eq 'responsible')
200             {
201 0           $co->responsible($c->getFirstChild()->getData());
202             } elsif ($n eq 'proxy')
203             {
204 0           $co->proxy($c->getFirstChild()->getData());
205             } elsif ($n eq 'domainName')
206             {
207 0           push @d,$c->getFirstChild()->getData();
208             }
209 0           } continue { $c=$c->getNextSibling(); }
210 0 0         $co->associated_contacts($cs) unless $cs->is_empty();
211 0 0         $co->associated_domains(\@d) if @d;
212 0           return;
213             }
214              
215             sub build_contacts
216             {
217 0     0 0   my $cs=shift;
218 0           my @n;
219 0           foreach my $t (sort($cs->types()))
220             {
221 0           push @n,map { ['brorg:contact',$_->srid(),{'type'=>$t}] } ($cs->get($t));
  0            
222             }
223 0           return @n;
224             }
225              
226             sub create
227             {
228 0     0 0   my ($epp,$contact,$rd)=@_;
229 0           my $mes=$epp->message();
230              
231 0 0         Net::DRI::Exception::usererr_invalid_parameters('contact must be Net::DRI::Data::Contact::BR object') unless Net::DRI::Util::isa_contact($contact,'Net::DRI::Data::Contact::BR');
232 0           my $orgid=$contact->orgid();
233 0 0         return unless defined($orgid); ## to be able to create pure contacts
234 0 0         Net::DRI::Exception::usererr_invalid_parameters('orgid must be an xml token string with 1 to 30 characters') unless Net::DRI::Util::xml_is_token($orgid,1,30);
235 0           my $cs=$contact->associated_contacts();
236 0 0         Net::DRI::Exception::usererr_invalid_parameters('associated_contacts must be a ContactSet object') unless Net::DRI::Util::isa_contactset($cs);
237 0 0         Net::DRI::Exception::usererr_insufficient_parameters('associated_contacts must not be empty') if $cs->is_empty();
238              
239 0           my $eid=build_command_extension($mes,$epp,'brorg:create');
240 0           my @n=(['brorg:organization',$orgid]);
241 0           push @n,build_contacts($cs);
242 0 0         push @n,['brorg:responsible',$contact->responsible()] if $contact->responsible();
243 0           $mes->command_extension($eid,\@n);
244 0           return;
245             }
246              
247             sub update
248             {
249 0     0 0   my ($epp,$contact,$todo)=@_;
250 0           my $mes=$epp->message();
251              
252 0 0         Net::DRI::Exception::usererr_invalid_parameters('contact must be Net::DRI::Data::Contact::BR object') unless Net::DRI::Util::isa_contact($contact,'Net::DRI::Data::Contact::BR');
253 0           my $orgid=$contact->orgid();
254 0 0         return unless defined($orgid); ## to be able to update pure contacts
255 0 0         Net::DRI::Exception::usererr_invalid_parameters('orgid must be an xml token string with 1 to 30 characters') unless Net::DRI::Util::xml_is_token($orgid,1,30);
256              
257 0           my $cadd=$todo->add('associated_contacts');
258 0           my $cdel=$todo->del('associated_contacts');
259 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('associated_contacts to add must be a ContactSet object') if (defined($cadd) && !Net::DRI::Util::isa_contactset($cadd));
260 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('associated_contacts to del must be a ContactSet object') if (defined($cdel) && !Net::DRI::Util::isa_contactset($cdel));
261              
262 0           my $resp=$todo->set('responsible');
263              
264 0 0 0       return unless (defined($cadd) || defined($cdel) || defined($resp));
      0        
265              
266 0           my @n=(['brorg:organization',$orgid]);
267 0 0         push @n,['brorg:add',build_contacts($cadd)] if defined($cadd);
268 0 0         push @n,['brorg:rem',build_contacts($cdel)] if defined($cdel);
269 0 0         push @n,['brorg:chg',['brorg:responsible',Net::DRI::Util::isa_contact($resp,'Net::DRI::Data::Contact::BR')? $resp->responsible() : $resp]] if defined($resp);
    0          
270 0           my $eid=build_command_extension($mes,$epp,'brorg:update');
271 0           $mes->command_extension($eid,\@n);
272 0           return;
273             }
274              
275             sub pandata_parse
276             {
277 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
278 0           my $mes=$po->message();
279 0 0         return unless $mes->is_success();
280              
281 0           my $pandata=$mes->get_extension('brorg','panData');
282 0 0         return unless $pandata;
283              
284 0           my $c=$pandata->firstChild();
285 0           while ($c)
286             {
287 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
288 0   0       my $n=$c->localname() || $c->nodeName();
289 0 0         next unless $n;
290 0 0         if ($n eq 'organization')
    0          
291             {
292 0           $rinfo->{$otype}->{$oname}->{orgid}=$c->getFirstChild()->getData();
293             } elsif ($n eq 'reason')
294             {
295 0           $rinfo->{$otype}->{$oname}->{reason}=$c->textContent(); ## this may be empty
296 0   0       $rinfo->{$otype}->{$oname}->{reason_lang}=$c->getAttribute('lang') || 'en';
297             }
298 0           } continue { $c=$c->getNextSibling(); }
299 0           return;
300             }
301              
302             ####################################################################################################
303             1;