File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/DNSBE/Domain.pm
Criterion Covered Total %
statement 21 147 14.2
branch 0 52 0.0
condition 0 30 0.0
subroutine 7 22 31.8
pod 0 15 0.0
total 28 266 10.5


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, DNSBE Domain EPP extension commands
2             ## (based on Registration_guidelines_v4_7_2-Part_4-epp.pdf)
3             ##
4             ## Copyright (c) 2006-2010,2013 Patrick Mevzek . All rights reserved.
5             ## (c) 2013 Michael Holloway . All rights reserved.
6             ##
7             ## This file is part of Net::DRI
8             ##
9             ## Net::DRI is free software; you can redistribute it and/or modify
10             ## it under the terms of the GNU General Public License as published by
11             ## the Free Software Foundation; either version 2 of the License, or
12             ## (at your option) any later version.
13             ##
14             ## See the LICENSE file that comes with this distribution for more details.
15             ####################################################################################################
16              
17             package Net::DRI::Protocol::EPP::Extensions::DNSBE::Domain;
18              
19 1     1   1558 use strict;
  1         3  
  1         28  
20 1     1   4 use warnings;
  1         2  
  1         21  
21              
22 1     1   5 use Carp;
  1         1  
  1         70  
23              
24 1     1   5 use Net::DRI::Util;
  1         2  
  1         25  
25 1     1   3 use Net::DRI::Exception;
  1         2  
  1         17  
26 1     1   6 use Net::DRI::Data::Hosts;
  1         2  
  1         16  
27 1     1   21 use Net::DRI::Protocol::EPP::Util;
  1         2  
  1         1730  
28              
29             =pod
30              
31             =head1 NAME
32              
33             Net::DRI::Protocol::EPP::Extensions::DNSBE::Domain - DNSBE EPP Domain extension commands for Net::DRI
34              
35             =head1 DESCRIPTION
36              
37             Please see the README file for details.
38              
39             =head1 SUPPORT
40              
41             For now, support questions should be sent to:
42              
43             Enetdri@dotandco.comE
44              
45             Please also see the SUPPORT file in the distribution.
46              
47             =head1 SEE ALSO
48              
49             Ehttp://www.dotandco.com/services/software/Net-DRI/E
50              
51             =head1 AUTHOR
52              
53             Patrick Mevzek, Enetdri@dotandco.comE
54              
55             =head1 COPYRIGHT
56              
57             Copyright (c) 2006-2010,2013 Patrick Mevzek .
58             All rights reserved.
59              
60             This program is free software; you can redistribute it and/or modify
61             it under the terms of the GNU General Public License as published by
62             the Free Software Foundation; either version 2 of the License, or
63             (at your option) any later version.
64              
65             See the LICENSE file that comes with this distribution for more details.
66              
67             =cut
68              
69             ####################################################################################################
70              
71             sub register_commands
72             {
73 0     0 0   my ($class,$version)=@_;
74 0           my %tmp=(
75             create => [ \&create, undef ],
76             update => [ \&update, undef ],
77             info => [ undef, \&info_parse ],
78             delete => [ \&delete, undef ],
79             transfer_request => [ \&transfer_request, undef ],
80             undelete => [ \&undelete, undef ],
81             transferq_request => [ \&transferq_request, undef ],
82             trade => [ \&trade, undef ],
83             reactivate => [ \&reactivate, undef ],
84             request_authcode => [ \&request_authcode, undef ],
85             );
86              
87 0           return { 'domain' => \%tmp };
88             }
89              
90             ####################################################################################################
91              
92             sub build_command_extension
93             {
94 0     0 0   my ($mes,$epp,$tag)=@_;
95 0           return $mes->command_extension_register($tag,sprintf('xmlns:dnsbe="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('dnsbe')));
96             }
97              
98             sub create
99             {
100 0     0 0   my ($epp,$domain,$rd)=@_;
101 0           my $mes=$epp->message();
102              
103             ## Registrant contact is mandatory (optional in EPP), already added in Core, we just verify here
104             Net::DRI::Exception->die(0,'protocol/EPP',11,'Registrant contact is mandatory in domain_create')
105 0 0 0       unless (Net::DRI::Util::has_contact($rd) && $rd->{contact}->get('registrant')->srid());
106              
107 0 0         return unless exists($rd->{nsgroup});
108 0           my @n=add_nsgroup($rd->{nsgroup});
109              
110 0           my $eid=build_command_extension($mes,$epp,'dnsbe:ext');
111 0           $mes->command_extension($eid,['dnsbe:create',['dnsbe:domain',@n]]);
112 0           return;
113             }
114              
115             sub update
116             {
117 0     0 0   my ($epp,$domain,$todo)=@_;
118 0           my $mes=$epp->message();
119              
120 0 0         if (grep { ! /^(?:add|del)$/ } $todo->types('nsgroup'))
  0            
121             {
122 0           Net::DRI::Exception->die(0,'protocol/EPP',11,'Only nsgroup add/del available for domain');
123             }
124              
125 0           my $nsgadd=$todo->add('nsgroup');
126 0           my $nsgdel=$todo->del('nsgroup');
127 0 0 0       return unless ($nsgadd || $nsgdel);
128              
129 0           my @n;
130 0 0         push @n,['dnsbe:add',add_nsgroup($nsgadd)] if $nsgadd;
131 0 0         push @n,['dnsbe:rem',add_nsgroup($nsgdel)] if $nsgdel;
132              
133 0           my $eid=build_command_extension($mes,$epp,'dnsbe:ext');
134 0           $mes->command_extension($eid,['dnsbe:update',['dnsbe:domain',@n]]);
135 0           return;
136             }
137              
138             ## This is not written in the PDF document, but it should probably be there, like for .EU
139             sub info_parse
140             {
141 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
142 0           my $mes=$po->message();
143 0 0         return unless $mes->is_success();
144              
145 0           my $infdata=$mes->get_extension('dnsbe','infData');
146 0 0         return unless $infdata;
147              
148 0           my @c;
149 0           foreach my $el ($infdata->getChildrenByTagNameNS($mes->ns('dnsbe'),'nsgroup'))
150             {
151 0           push @c,Net::DRI::Data::Hosts->new()->name($el->getFirstChild()->getData());
152             }
153              
154 0           $rinfo->{domain}->{$oname}->{nsgroup}=\@c;
155 0           return;
156             }
157              
158             sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms)
159             {
160 0     0 0   my ($epp,$domain,$rd)=@_;
161 0           my $mes=$epp->message();
162              
163 0 0 0       return unless (exists($rd->{deleteDate}) && $rd->{deleteDate});
164              
165 0           Net::DRI::Util::check_isa($rd->{deleteDate},'DateTime');
166              
167 0           my $eid=build_command_extension($mes,$epp,'dnsbe:ext');
168 0           my @n=('dnsbe:delete',['dnsbe:domain',['dnsbe:deleteDate',$rd->{deleteDate}->set_time_zone('UTC')->strftime("%Y-%m-%dT%T.%NZ")]]);
169 0           $mes->command_extension($eid,\@n);
170 0           return;
171             }
172              
173             sub transfer_request
174             {
175 0     0 0   my ($epp,$domain,$rd)=@_;
176 0           my $mes=$epp->message();
177              
178 0           my @n=add_transfer($epp,$mes,$domain,$rd);
179 0           my $eid=build_command_extension($mes,$epp,'dnsbe:ext');
180 0           $mes->command_extension($eid,['dnsbe:transfer',['dnsbe:domain',@n]]);
181 0           return;
182             }
183              
184             sub add_transfer
185             {
186 0     0 0   my ($epp,$mes,$domain,$rd)=@_;
187              
188 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('registrant and billing are mandatory') unless (Net::DRI::Util::has_contact($rd) && $rd->{contact}->has_type('registrant') && $rd->{contact}->has_type('billing'));
      0        
189              
190 0           my $cs=$rd->{contact};
191 0           my @n;
192              
193 0           my $creg=$cs->get('registrant');
194 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('registrant must be a contact object or #AUTO#') unless (Net::DRI::Util::isa_contact($creg,'Net::DRI::Data::Contact::BE') || (!ref($creg) && ($creg eq '#AUTO#')));
      0        
195 0 0         push @n,['dnsbe:registrant',ref($creg)? $creg->srid() : '#AUTO#' ];
196              
197 0 0         if (exists($rd->{trDate}))
198             {
199 0           Net::DRI::Util::check_isa($rd->{trDate},'DateTime');
200 0           push @n,['dnsbe:trDate',$rd->{trDate}->set_time_zone('UTC')->strftime('%Y-%m-%dT%T.%NZ')];
201             }
202              
203 0           my $cbill=$cs->get('billing');
204 0 0         Net::DRI::Exception::usererr_invalid_parameters('billing must be a contact object') unless Net::DRI::Util::isa_contact($cbill,'Net::DRI::Data::Contact::BE');
205 0           push @n,['dnsbe:billing',$cbill->srid()];
206              
207 0 0         push @n,add_contact('accmgr',$cs,1) if $cs->has_type('accmgr');
208 0 0         push @n,add_contact('tech',$cs,9) if $cs->has_type('tech');
209 0 0         push @n,add_contact('onsite',$cs,5) if $cs->has_type('onsite');
210              
211 0 0         if (Net::DRI::Util::has_ns($rd))
212             {
213 0           my $n=Net::DRI::Protocol::EPP::Util::build_ns($epp,$rd->{ns},$domain,'dnsbe');
214 0           my @ns=$mes->nsattrs('domain');
215 0           push @$n,{'xmlns:domain'=>shift(@ns),'xsi:schemaLocation'=>sprintf('%s %s',@ns)};
216 0           push @n,$n;
217             }
218              
219 0 0         push @n,add_nsgroup($rd->{nsgroup}) if (exists($rd->{nsgroup}));
220 0           return @n;
221             }
222              
223             sub add_nsgroup
224             {
225 0     0 0   my ($nsg)=@_;
226 0 0 0       return unless (defined($nsg) && $nsg);
227 0 0 0       my @a=grep { defined($_) && $_ && !ref($_) && Net::DRI::Util::xml_is_normalizedstring($_,1,100) } map { Net::DRI::Util::isa_hosts($_)? $_->name() : $_ } (ref($nsg) eq 'ARRAY')? @$nsg : ($nsg);
  0 0 0        
  0 0          
228 0           return map { ['dnsbe:nsgroup',$_] } grep {defined} @a[0..8];
  0            
  0            
229             }
230              
231             sub add_contact
232             {
233 0     0 0   my ($type,$cs,$max)=@_;
234 0           $max--;
235 0           my @r=grep { Net::DRI::Util::isa_contact($_,'Net::DRI::Data::Contact::BE') } ($cs->get($type));
  0            
236 0           return map { ['dnsbe:'.$type,$_->srid()] } grep {defined} @r[0..$max];
  0            
  0            
237             }
238              
239             sub undelete
240             {
241 0     0 0   my ($epp,$domain)=@_;
242 0           my $mes=$epp->message();
243 0           my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,'undelete',$domain);
244 0           $mes->command_body(\@d);
245 0           return;
246             }
247              
248             sub transferq_request
249             {
250 0     0 0   my ($epp,$domain,$rd)=@_;
251 0           my $mes=$epp->message();
252 0           my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,['transferq',{'op'=>'request'}],$domain);
253              
254 0 0         Carp::croak('Key "period" should be key "duration"') if Net::DRI::Util::has_key($rd,'period');
255 0 0         push @d,Net::DRI::Protocol::EPP::Util::build_period($rd->{period}) if Net::DRI::Util::has_duration($rd);
256 0           $mes->command_body(\@d);
257              
258 0           my @n=add_transfer($epp,$mes,$domain,$rd);
259 0           my $eid=build_command_extension($mes,$epp,'dnsbe:ext');
260 0           $mes->command_extension($eid,['dnsbe:transferq',['dnsbe:domain',@n]]);
261 0           return;
262             }
263              
264             sub trade
265             {
266 0     0 0   my ($epp,$domain,$rd)=@_;
267 0           my $mes=$epp->message();
268 0           my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,['trade',{'op'=>'request'}],$domain);
269 0           $mes->command_body(\@d);
270              
271 0           my @n=add_transfer($epp,$mes,$domain,$rd);
272 0           my $eid=build_command_extension($mes,$epp,'dnsbe:ext');
273 0           $mes->command_extension($eid,['dnsbe:trade',['dnsbe:domain',@n]]);
274 0           return;
275             }
276              
277             sub reactivate
278             {
279 0     0 0   my ($epp,$domain)=@_;
280 0           my $mes=$epp->message();
281 0           my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,'reactivate',$domain);
282 0           $mes->command_body(\@d);
283 0           return;
284             }
285              
286             sub request_authcode
287             {
288 0     0 0   my ($epp,$domain,$rd)=@_;
289 0           my $mes=$epp->message();
290 0           my $trid = $mes->cltrid();
291 0           my $eid=build_command_extension($mes,$epp,'dnsbe:ext');
292 0           my @d;
293 0           push @d,['dnsbe:domainName',$domain];
294 0 0         push @d,['dnsbe:url',$rd->{'url'}] if $rd->{'url'};
295 0           $mes->command_extension($eid,['dnsbe:command',['dnsbe:requestAuthCode',@d],['dnsbe:clTRID',$trid]]);
296             # missing TRID
297 0           return;
298             }
299              
300             ####################################################################################################
301             1;