File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/EURid/Sunrise.pm
Criterion Covered Total %
statement 27 114 23.6
branch 0 66 0.0
condition 0 18 0.0
subroutine 9 15 60.0
pod 0 6 0.0
total 36 219 16.4


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, EURid Sunrise EPP extension for Net::DRI
2             ## (from registration_guidelines_v1_0F-appendix2-sunrise.pdf )
3             ##
4             ## Copyright (c) 2005,2007-2010,2012,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::EURid::Sunrise;
17              
18 1     1   1494 use strict;
  1         1  
  1         27  
19 1     1   3 use warnings;
  1         2  
  1         22  
20              
21 1     1   5 use Email::Valid;
  1         1  
  1         18  
22 1     1   3 use DateTime::Format::ISO8601;
  1         2  
  1         18  
23              
24 1     1   3 use Net::DRI::Util;
  1         2  
  1         16  
25 1     1   3 use Net::DRI::Exception;
  1         2  
  1         23  
26 1     1   526 use Net::DRI::Protocol::EPP::Extensions::EURid::Domain;
  1         1  
  1         32  
27 1     1   6 use Net::DRI::DRD::EURid;
  1         1  
  1         21  
28 1     1   4 use Net::DRI::Protocol::EPP::Util;
  1         2  
  1         1207  
29              
30             =pod
31              
32             =head1 NAME
33              
34             Net::DRI::Protocol::EPP::Extensions::EURid::Sunrise - EURid Sunrise EPP extension for Net::DRI
35              
36             =head1 DESCRIPTION
37              
38             Please see the README file for details.
39              
40             =head1 SUPPORT
41              
42             For now, support questions should be sent to:
43              
44             Enetdri@dotandco.comE
45              
46             Please also see the SUPPORT file in the distribution.
47              
48             =head1 SEE ALSO
49              
50             Ehttp://www.dotandco.com/services/software/Net-DRI/E
51              
52             =head1 AUTHOR
53              
54             Patrick Mevzek, Enetdri@dotandco.comE
55              
56             =head1 COPYRIGHT
57              
58             Copyright (c) 2005,2007-2010,2012,2013 Patrick Mevzek .
59             All rights reserved.
60              
61             This program is free software; you can redistribute it and/or modify
62             it under the terms of the GNU General Public License as published by
63             the Free Software Foundation; either version 2 of the License, or
64             (at your option) any later version.
65              
66             See the LICENSE file that comes with this distribution for more details.
67              
68             =cut
69              
70             ####################################################################################################
71              
72             sub register_commands
73             {
74 0     0 0   my ($class,$version)=@_;
75 0           my %tmp=(
76             apply => [ \&apply, \&apply_parse ],
77             apply_info => [ \&info, \&info_parse ],
78             );
79              
80 0           return { 'domain' => \%tmp };
81             }
82              
83             sub setup
84             {
85 0     0 0   my ($class,$po,$version)=@_;
86 0           $po->ns({ 'sunrise' => [ 'http://www.eurid.eu/xml/epp/sunrise-1.0','sunrise-1.0.xsd' ] });
87 0           return;
88             }
89              
90             ####################################################################################################
91              
92             ########### Query commands
93              
94             sub info
95             {
96 0     0 0   my ($epp,$reference)=@_;
97 0           my $mes=$epp->message();
98              
99 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('Apply_info action needs a reference') unless defined($reference) && $reference;
100 0 0         Net::DRI::Exception::usererr_invalid_parameters('reference must be a xml normalizedstring from 1 to 100 characters long') unless Net::DRI::Util::xml_is_normalizedstring($reference,1,100);
101              
102 0           $mes->command(['apply-info','domain:apply-info',sprintf('xmlns:domain="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('domain'))]);
103 0           $mes->command_body([['domain:reference',$reference]]);
104 0           return;
105             }
106              
107             sub info_parse
108             {
109 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
110 0           my $mes=$po->message();
111 0 0         return unless $mes->is_success();
112              
113 0           my $infdata=$mes->get_response('domain','appInfoData');
114 0 0         return unless $infdata;
115              
116 0           my $cs=Net::DRI::Data::ContactSet->new();
117 0           my $pd=DateTime::Format::ISO8601->new();
118 0           my $c=$infdata->firstChild();
119 0           while ($c)
120             {
121 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
122 0           my $name=$c->nodeName();
123 0 0         next unless $name;
124              
125 0 0         if ($name=~m/^domain:(name|reference|code)$/)
    0          
    0          
    0          
    0          
    0          
    0          
126             {
127 0           $rinfo->{domain}->{$oname}->{$1}=$c->firstChild->getData();
128             } elsif ($name eq 'domain:status')
129             {
130 0           $rinfo->{domain}->{$oname}->{application_status}=$c->firstChild->getData();
131             } elsif ($name=~m/^domain:(crDate|docsReceivedDate)$/)
132             {
133 0           $rinfo->{domain}->{$oname}->{$1}=$pd->parse_datetime($c->firstChild->getData());
134             } elsif ($name eq 'domain:registrant')
135             {
136 0           $cs->set($po->create_local_object('contact')->srid($c->firstChild->getData()),'registrant');
137             } elsif ($name eq 'domain:contact')
138             {
139 0           $cs->add($po->create_local_object('contact')->srid($c->firstChild->getData()),$c->getAttribute('type'));
140             } elsif ($name eq 'domain:ns')
141             {
142 0           $rinfo->{domain}->{$oname}->{ns}=Net::DRI::Protocol::EPP::Util::parse_ns($po,$c);
143             } elsif ($name eq 'domain:adr')
144             {
145 0           $rinfo->{domain}->{$oname}->{adr}=Net::DRI::Util::xml_parse_boolean($c->firstChild->getData());
146             }
147 0           } continue { $c=$c->getNextSibling(); }
148              
149 0           $rinfo->{domain}->{$oname}->{contact}=$cs;
150 0           return;
151             }
152              
153             ############ Transform commands
154              
155             sub apply
156             {
157 0     0 0   my ($epp,$domain,$rd)=@_;
158 0           my $mes=$epp->message();
159 0           my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,'apply',$domain);
160              
161 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('Apply action needs parameters') unless (defined($rd) && (ref($rd) eq 'HASH'));
162 0   0       my @need=grep { !(exists($rd->{$_}) && $rd->{$_}) } qw/reference right prior-right-on-name prior-right-country documentaryevidence evidence-lang/;
  0            
163 0 0         Net::DRI::Exception::usererr_insufficient_parameters('The following parameters are needed: '.join(' ',@need)) if @need;
164              
165 0 0         Net::DRI::Exception::usererr_invalid_parameters('reference must be a xml normalizedstring from 1 to 100 characters long') unless Net::DRI::Util::xml_is_normalizedstring($rd->{reference},1,100);
166 0           push @d,['domain:reference',$rd->{reference}];
167              
168 0 0         Net::DRI::Exception::usererr_invalid_parameters('right must be PUBLICBODY, REG-TM-NAT, REG-TM-COM-INTL, GEO-DOO, COMP-ID, UNREG-TM, TITLES-ART, OTHER') unless ($rd->{right}=~m/^(?:PUBLICBODY|REG-TM-NAT|REG-TM-COM-INTL|GEO-DOO|COMP-ID|UNREG-TM|TITLES-ART|OTHER)/);
169 0           push @d,['domain:right',$rd->{right}];
170              
171 0 0         Net::DRI::Exception::usererr_invalid_parameters('prior-right-on-name must be a xml token from 1 to 255 characters long') unless Net::DRI::Util::xml_is_token($rd->{'prior-right-on-name'},1,255);
172 0           push @d,['domain:prior-right-on-name',$rd->{'prior-right-on-name'}];
173              
174 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('prior-right-country must be a CC of EU member') unless (length($rd->{'prior-right-country'})==2 && exists($Net::DRI::DRD::EURid::CCA2_EU{uc($rd->{'prior-right-country'})})); ####
175 0           push @d,['domain:prior-right-country',uc($rd->{'prior-right-country'})];
176              
177 0 0         Net::DRI::Exception::usererr_invalid_parameters('documentaryevidence must be applicant, registrar or thirdparty') unless $rd->{documentaryevidence}=~m/^(?:applicant|registrar|thirdparty)$/;
178 0 0         if ($rd->{documentaryevidence} eq 'thirdparty')
179             {
180 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('documentaryevidence_email must be a valid email address') unless (defined($rd->{documentaryevidence_email}) && Email::Valid->rfc822($rd->{documentaryevidence_email}));
181 0           push @d,['domain:documentaryevidence',['domain:thirdparty',$rd->{documentaryevidence_email}]];
182             } else
183             {
184 0           push @d,['domain:documentaryevidence',['domain:'.$rd->{documentaryevidence}]];
185             }
186              
187 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('evidence-lang must be a lang of EU member') unless (length($rd->{'evidence-lang'})==2 && exists($Net::DRI::DRD::EURid::LANGA2_EU{lc($rd->{'evidence-lang'})})); ####
188 0           push @d,['domain:evidence-lang',lc($rd->{'evidence-lang'})];
189              
190              
191             ## Nameservers, OPTIONAL
192 0 0         push @d,Net::DRI::Protocol::EPP::Util::build_ns($epp,$rd->{ns},$domain,'domain') if Net::DRI::Util::has_ns($rd);
193              
194             ## Contacts, all OPTIONAL
195 0 0         if (Net::DRI::Util::has_contact($rd))
196             {
197 0           my $cs=$rd->{contact};
198 0           my @o=$cs->get('registrant');
199 0 0         push @d,['domain:registrant',$o[0]->srid()] if (@o);
200 0           push @d,Net::DRI::Protocol::EPP::Util::build_core_contacts($epp,$cs);
201             }
202              
203 0           $mes->command_body(\@d);
204              
205             ## Nameserver groups
206 0 0         if (exists($rd->{nsgroup}))
207             {
208 0           my @n=Net::DRI::Protocol::EPP::Extensions::EURid::Domain::add_nsgroup($rd->{nsgroup});
209 0           my $eid=Net::DRI::Protocol::EPP::Extensions::EURid::Domain::build_command_extension($mes,$epp,'eurid:ext');
210 0           $mes->command_extension($eid,['eurid:apply',['eurid:domain',@n]]);
211             }
212 0           return;
213             }
214              
215             sub apply_parse
216             {
217 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
218 0           my $mes=$po->message();
219 0           $rinfo->{_internal}->{must_reconnect}=1; ## All apply commands (successful or not) close the connection
220 0 0         return unless $mes->is_success();
221              
222 0           my $credata=$mes->get_response('domain','appData');
223 0 0         return unless $credata;
224              
225 0           $rinfo->{domain}->{$oname}->{exist}=1;
226              
227 0           my $c=$credata->firstChild();
228 0           while ($c)
229             {
230 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
231 0           my $name=$c->nodeName();
232 0 0         next unless $name;
233              
234 0 0         if ($name=~m/^domain:(name|reference|code)$/)
    0          
235             {
236 0           $rinfo->{domain}->{$oname}->{$1}=$c->firstChild->getData();
237             } elsif ($name=~m/^domain:(crDate)$/)
238             {
239 0           $rinfo->{domain}->{$oname}->{$1}=DateTime::Format::ISO8601->new()->parse_datetime($c->firstChild->getData());
240             }
241 0           } continue { $c=$c->getNextSibling(); }
242 0           return;
243             }
244              
245             ####################################################################################################
246             1;