File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/NO/Message.pm
Criterion Covered Total %
statement 27 134 20.1
branch 0 68 0.0
condition 0 33 0.0
subroutine 9 17 52.9
pod 0 8 0.0
total 36 260 13.8


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .NO message extensions
2             ##
3             ## Copyright (c) 2008-2010,2013 UNINETT Norid AS, Ehttp://www.norid.noE,
4             ## Trond Haugen Einfo@norid.noE
5             ## 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::NO::Message;
18              
19 1     1   967 use strict;
  1         2  
  1         22  
20 1     1   4 use warnings;
  1         1  
  1         17  
21              
22 1     1   4 use Net::DRI::Util;
  1         1  
  1         17  
23 1     1   3 use Net::DRI::Exception;
  1         2  
  1         13  
24 1     1   3 use Net::DRI::Protocol::EPP::Core::Domain;
  1         1  
  1         16  
25 1     1   3 use Net::DRI::Protocol::EPP::Extensions::NO::Contact;
  1         1  
  1         16  
26 1     1   3 use Net::DRI::Protocol::EPP::Extensions::NO::Host;
  1         1  
  1         15  
27 1     1   445 use Net::DRI::Protocol::EPP::Extensions::NO::Result;
  1         2  
  1         26  
28 1     1   4 use Net::DRI::Protocol::EPP::Util;
  1         2  
  1         1096  
29              
30             =pod
31              
32             =head1 NAME
33              
34             Net::DRI::Protocol::EPP::Extensions::NO::Message - .NO Mesage Extensions 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             Trond Haugen, Einfo@norid.noE
55              
56             =head1 COPYRIGHT
57              
58             Copyright (c) 2008-2010,2013 UNINETT Norid AS, Ehttp://www.norid.noE,
59             Trond Haugen Einfo@norid.noE
60             All rights reserved.
61              
62             This program is free software; you can redistribute it and/or modify
63             it under the terms of the GNU General Public License as published by
64             the Free Software Foundation; either version 2 of the License, or
65             (at your option) any later version.
66              
67             See the LICENSE file that comes with this distribution for more details.
68              
69             =cut
70              
71             ################################################################################################
72              
73             sub register_commands {
74 0     0 0   my ( $class, $version ) = @_;
75              
76 0           my %tmp = (
77             noretrieve => [ \&pollreq, \&parse_poll ],
78             nodelete => [ \&pollack, \&Net::DRI::Protocol::EPP::Extensions::NO::Result::condition_parse ],
79             );
80              
81 0           return { 'message' => \%tmp };
82             }
83              
84             sub facet {
85 0     0 0   my ( $epp, $rd ) = @_;
86              
87 0           return Net::DRI::Protocol::EPP::Extensions::NO::Host::build_facets( $epp, $rd );
88             }
89              
90             sub pollack {
91 0     0 0   my ( $epp, $msgid, $rd ) = @_;
92              
93 0           my $mes = $epp->message();
94 0           my $r = ( $mes->command( [ [ 'poll', { op => 'ack', msgID => $msgid } ] ] ) );
95              
96 0 0 0       if (defined($rd->{facets}) && $rd->{facets}) {
97 0           $r = facet( $epp, $rd );
98             }
99 0           return $r;
100             }
101              
102             sub pollreq {
103 0     0 0   my ( $epp, $rd ) = @_;
104              
105 0           my $mes = $epp->message();
106              
107 0           my $r = ( $mes->command( [ [ 'poll', { op => 'req' } ] ] ) );
108              
109 0 0 0       if (defined($rd->{facets}) && $rd->{facets}) {
110 0           $r = facet( $epp, $rd );
111             }
112            
113 0           return $r;
114             }
115              
116             sub parse_resp_result
117             {
118 0     0 0   my ($node, $NS, $rinfo, $msgid)=@_;
119              
120 0           push @{$rinfo->{message}->{$msgid}->{results}},Net::DRI::Protocol::EPP::Util::parse_node_result($node,$NS,'no');
  0            
121 0           return;
122             }
123              
124             sub transfer_resp_parse {
125 0     0 0   my ($po, $trndata, $oname, $rinfo, $msgid)=@_;
126              
127 0 0         return unless $trndata;
128              
129 0           foreach my $el (Net::DRI::Util::xml_list_children($trndata))
130             {
131 0           my ($name,$c)=@$el;
132              
133 0 0         if ($name eq 'name') {
    0          
    0          
134 0           $oname=lc($c->textContent());
135 0           $rinfo->{message}->{$msgid}->{domain}->{$oname}->{action}='transfer';
136              
137 0           $rinfo->{message}->{$msgid}->{domain}->{$oname}->{exist}=1;
138             } elsif ($name=~m/^(trStatus|reID|acID)$/mx) {
139 0 0         $rinfo->{message}->{$msgid}->{domain}->{$oname}->{$1}=$c->textContent() if ($c->getFirstChild());
140             } elsif ($name=~m/^(reDate|acDate|exDate)$/mx) {
141 0           $rinfo->{message}->{$msgid}->{domain}->{$oname}->{$1}=$po->parse_iso8601($c->textContent());
142             }
143             }
144 0           return;
145             }
146              
147             sub contact_resp_parse {
148 0     0 0   my ($po, $credata, $oname, $rinfo, $msgid)=@_;
149              
150 0 0         return unless $credata;
151            
152 0           foreach my $el (Net::DRI::Util::xml_list_children($credata))
153             {
154 0           my ($name,$c)=@$el;
155 0 0         if ($name eq 'id')
    0          
156             {
157 0           my $new=$c->getFirstChild()->getData();
158 0 0 0       $rinfo->{message}->{$msgid}->{contact}->{$oname}->{id}=$new if (defined($oname) && ($oname ne $new)); ## registry may give another id than the one we requested or not take ours into account at all !
159 0           $oname=$new;
160 0           $rinfo->{message}->{$msgid}->{contact}->{$oname}->{id}=$oname;
161 0           $rinfo->{message}->{$msgid}->{contact}->{$oname}->{action}='create';
162 0           $rinfo->{message}->{$msgid}->{contact}->{$oname}->{exist}=1;
163             } elsif ($name=~m/^(crDate)$/)
164             {
165 0           $rinfo->{message}->{$msgid}->{contact}->{$oname}->{$1}=$po->parse_iso8601($c->textContent());
166             }
167             }
168 0           return;
169             }
170              
171             ## We take into account all parse functions, to be able to parse any result
172             sub parse_poll {
173 0     0 0   my ( $po, $otype, $oaction, $oname, $rinfo ) = @_;
174 0           my $mes = $po->message();
175              
176 0           my $eppNS = $mes->ns('_main');
177              
178             # both message and results are defined by the same no-ext-result schema
179 0           my $NS = $mes->ns('no_result');
180              
181 0 0         return unless $mes->is_success();
182 0 0         return if $mes->result_is('COMMAND_SUCCESSFUL_QUEUE_EMPTY');
183              
184 0           my $msgid = $mes->msg_id();
185 0           $rinfo->{message}->{session}->{last_id} = $msgid;
186              
187             ## Parse any message
188 0           my $mesdata = $mes->get_response('no_result','message');
189              
190 0           $rinfo->{$otype}->{$oname}->{message} = $mesdata;
191 0 0         return unless $mesdata;
192              
193 0           my ( $epp, $rep, $ext, $ctag, @conds, @tags );
194 0           my $command = $mesdata->getAttribute('type');
195              
196 0           @tags = $mesdata->getElementsByTagNameNS( $NS, 'desc' );
197              
198             # We supplement the standard top desc with our more detailed one
199 0 0 0       if (@tags && $tags[0]->getFirstChild() && $tags[0]->getFirstChild()->getData()) {
      0        
200 0           $rinfo->{message}->{$msgid}->{nocontent} = $tags[0]->getFirstChild()->getData();
201             }
202              
203             #
204             # Now the data tag
205 0           @tags = $mesdata->getElementsByTagNameNS( $NS, 'data' );
206 0 0         return unless @tags;
207              
208 0           my $data = $tags[0];
209              
210             ##
211             # Inside a data we can have variants,
212             # a normal result block in the start, then an
213             # which is a sequence, the other is a late response which will contain
214             # a complete and ordinary EPP response, only delayed.
215              
216             #
217             # Parse any ordinary result block(s)
218             #
219 0           foreach my $result ($data->getElementsByTagNameNS($eppNS,'result')) {
220 0           parse_resp_result($result, $eppNS, $rinfo, $msgid);
221             }
222              
223             ###
224             # Parse entry
225             #
226 0           @tags = $data->getElementsByTagNameNS( $NS, 'entry' );
227              
228 0           foreach my $entry (@tags) {
229 0 0         next unless ( defined( $entry->getAttribute('name') ) );
230              
231 0 0         if ( $entry->getAttribute('name') eq 'objecttype' ) {
    0          
    0          
    0          
232             $rinfo->{message}->{$msgid}->{object_type}
233 0           = $entry->getFirstChild()->getData();
234             } elsif ( $entry->getAttribute('name') eq 'command' ) {
235             $rinfo->{message}->{$msgid}->{action}
236 0           = $entry->getFirstChild()->getData();
237             } elsif ( $entry->getAttribute('name') eq 'objectname' ) {
238             $rinfo->{message}->{$msgid}->{object_id}
239 0           = $entry->getFirstChild()->getData();
240             } elsif (
241             $entry->getAttribute('name') =~ /^(domain|contact|host)$/mx )
242             {
243 0           $rinfo->{message}->{$msgid}->{object_type} = $1;
244             $rinfo->{message}->{$msgid}->{object_id}
245 0           = $entry->getFirstChild()->getData();
246             }
247             }
248              
249 0   0       $rinfo->{message}->{$msgid}->{action} ||= $command;
250              
251             ###
252             # The various EPP late response messages can be encapsulated in the service message data.
253             # There may in principle be any type of object response, so we try to parse all variants
254             # We try to use our various parse methods, copy the data and copy the data from it
255             # into our message structure. The delete the source data to hopefully not
256             # contaminate anything.
257              
258             ##
259             # inside a data and a late-responses, an inner TRID pair should exist.
260             # No more than one inner TRID pair is expected and handled
261             # In case more exist, the first one is used.
262             # Find the values and stash them in an $rinfo->{message}->{$msgid}->{trid} hash
263              
264 0 0         if (my $trid=(($data->getElementsByTagNameNS($eppNS,'trID'))[0])) {
265 0           my $tmp=Net::DRI::Util::xml_child_content($trid,$eppNS,'clTRID');
266 0 0         $rinfo->{message}->{$msgid}->{trid}->{cltrid} = $tmp if defined($tmp);
267 0           $tmp = Net::DRI::Util::xml_child_content($trid,$eppNS,'svTRID');
268 0 0         $rinfo->{message}->{$msgid}->{trid}->{svtrid} = $tmp if defined($tmp);
269             }
270              
271             # Parse any domain command late response data
272 0 0         if (my $infdata=$mes->get_response('domain','infData')) {
273 0           Net::DRI::Protocol::EPP::Core::Domain::info_parse($po,'domain','info',$oname,$rinfo);
274              
275 0 0 0       if (defined($rinfo->{domain}) && $rinfo->{domain}) {
276 0           $rinfo->{message}->{$msgid}->{domain} = $rinfo->{domain};
277 0           delete($rinfo->{domain});
278             }
279             }
280              
281             # Parse any domain transfer late response data
282 0 0         if (my $trndata = (($data->getElementsByTagNameNS($mes->ns('domain'), 'trnData'))[0])) {
283 0           transfer_resp_parse($po, $trndata, $oname, $rinfo, $msgid);
284             }
285              
286             # Parse any any contact create late response data
287 0 0         if (my $credata = (($data->getElementsByTagNameNS($mes->ns('contact'), 'creData'))[0])) {
288 0           contact_resp_parse($po, $credata, $oname, $rinfo, $msgid);
289             }
290              
291             # Parse any any contact info late response data
292 0 0         if (my $condata = $mes->get_extension('no_contact','infData')) {
293 0           Net::DRI::Protocol::EPP::Extensions::NO::Contact::parse_info($po,'contact', 'info',$oname,$rinfo);
294 0 0 0       if (defined($rinfo->{contact}) && $rinfo->{contact}) {
295 0           $rinfo->{message}->{$msgid}->{contact} = $rinfo->{contact};
296 0           delete ($rinfo->{contact});
297             }
298             }
299              
300             # Parse any any host info late response data
301 0 0         if (my $condata = $mes->get_extension('no_host','infData')) {
302 0           Net::DRI::Protocol::EPP::Extensions::NO::Host::parse_info($po,'host','info',$oname,$rinfo);
303              
304 0 0 0       if (defined($rinfo->{host}) && $rinfo->{host}) {
305 0           $rinfo->{message}->{$msgid}->{host} = $rinfo->{host};
306 0           delete($rinfo->{host});
307             }
308             }
309              
310             # Parse any result extension conditions
311 0           my $innerepp=$data->getElementsByTagNameNS($eppNS,'epp')->shift();
312 0           my $condata;
313 0 0 0       if (defined($innerepp) && ($condata = $innerepp->getElementsByTagNameNS($NS,'conditions'))) {
314 0           Net::DRI::Protocol::EPP::Extensions::NO::Result::parse($mes,$otype,$oname,$rinfo,$condata->shift());
315              
316 0 0 0       if ((defined($rinfo->{$otype}->{$oname}->{conditions})) &&
317             $rinfo->{$otype}->{$oname}->{conditions}) {
318 0           $rinfo->{message}->{$msgid}->{conditions} = $rinfo->{$otype}->{$oname}->{conditions};
319             #delete ($rinfo->{$otype}->{$oname}->{conditions});
320             }
321             }
322 0           return 1;
323             }
324              
325             ####################################################################################################
326             1;