File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/SIDN/Notifications.pm
Criterion Covered Total %
statement 9 82 10.9
branch 0 42 0.0
condition 0 3 0.0
subroutine 3 8 37.5
pod 0 5 0.0
total 12 140 8.5


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, SIDN EPP Notifications
2             ##
3             ## Copyright (c) 2009,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::SIDN::Notifications;
16              
17 1     1   956 use strict;
  1         2  
  1         27  
18 1     1   4 use warnings;
  1         2  
  1         22  
19              
20 1     1   4 use Net::DRI::Util;
  1         1  
  1         919  
21              
22             ####################################################################################################
23              
24             sub register_commands
25             {
26 0     0 0   my ($class,$version)=@_;
27 0           my %tmp=(
28             review_sidn => [ undef, \&parse_sidn ],
29             );
30              
31 0           return { 'message' => \%tmp };
32             }
33              
34             ####################################################################################################
35              
36             sub parse_sidn
37             {
38 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
39 0           my $mes=$po->message();
40 0 0         return unless $mes->is_success();
41 0           my $node=$mes->get_response('sidn','pollData');
42 0 0         return unless defined $node;
43              
44 0           $oname='_unknown'; ## some messages carry back very little useful information !
45 0           my $id=$mes->msg_id();
46 0           my $nsepp=$mes->ns('_main');
47 0           my %h=(action => 'review_sidn');
48 0           my $cmd;
49 0           foreach my $el (Net::DRI::Util::xml_list_children($node))
50             {
51 0           my ($name,$n)=@$el;
52 0 0         if ($name eq 'command')
    0          
53             {
54 0           $cmd=$n->textContent();
55 0           ($otype)=($cmd=~m/^(\S+):/);
56 0           $h{object_type}=$otype;
57             } elsif ($name eq 'data')
58             {
59 0           foreach my $subel (Net::DRI::Util::xml_list_children($n))
60             {
61 0           my ($subname,$subnode)=@$subel;
62 0 0         if ($subname eq 'result')
    0          
    0          
63             {
64 0           $h{result_code}=$subnode->getAttribute('code');
65 0           $h{result_msg}=Net::DRI::Util::xml_child_content($subnode,$nsepp,'msg');
66             } elsif ($subname eq 'resData')
67             {
68 0 0 0       if ($cmd eq 'domain:create')
    0          
    0          
    0          
69             {
70 0           $oname=Net::DRI::Util::xml_child_content($subnode,$nsepp,'name');
71 0           $h{crDate}=$po->parse_iso8601(Net::DRI::Util::xml_child_content($subnode,$nsepp,'crDate'));
72 0           $h{exist}=1;
73             } elsif ($cmd eq 'domain:transfer-token-reminder')
74             {
75 0           $oname=reminder_parse($po,$subnode,$mes->ns('sidn'),\%h);
76 0           $h{exist}=1;
77             } elsif ($cmd eq 'domain:transfer-token-supply')
78             {
79 0           $oname=supply_parse($po,$subnode,$mes->ns('sidn'),\%h);
80 0           $h{exist}=1;
81             } elsif ($cmd eq 'domain:transfer' || $cmd eq 'domain:transfer-start')
82             {
83 0           $oname=transfer_parse($po,$subnode,$mes->ns('domain'),\%h);
84 0           $h{exist}=1;
85             }
86             } elsif ($subname eq 'trID')
87             {
88 0           $h{trid}=Net::DRI::Util::xml_child_content($subnode,$nsepp,'clTRID');
89 0           $h{svtrid}=Net::DRI::Util::xml_child_content($subnode,$nsepp,'svTRID');
90             }
91             }
92             }
93             }
94              
95             ## Do not know if all of this is the good way to do, as these notifications are very strangely formatted
96 0           $cmd=~s/:/_/;
97 0           $cmd=~s/-/_/g;
98 0           $h{command}=$cmd;
99 0           while(my ($k,$v)=each(%h))
100             {
101 0           $rinfo->{$otype}->{$oname}->{$k}=$v;
102             }
103              
104 0           return;
105             }
106              
107             sub transfer_parse
108             {
109 0     0 0   my ($po,$trndata,$ns,$rh)=@_;
110 0           $trndata=Net::DRI::Util::xml_traverse($trndata,$ns,'trnData');
111              
112 0           my $oname;
113             ## The following is basically a copy from Core/Domain::transfer_parse !
114 0           foreach my $el (Net::DRI::Util::xml_list_children($trndata))
115             {
116 0           my ($name,$c)=@$el;
117 0 0         if ($name eq 'name')
    0          
    0          
118             {
119 0           $oname=lc($c->textContent());
120             } elsif ($name=~m/^(trStatus|reID|acID)$/)
121             {
122 0           $rh->{$1}=$c->textContent();
123             } elsif ($name=~m/^(reDate|acDate|exDate)$/)
124             {
125 0           $rh->{$1}=$po->parse_iso8601($c->textContent());
126             }
127             }
128 0           return $oname;
129             }
130              
131             sub reminder_parse
132             {
133 0     0 0   my ($po,$trndata,$ns,$rh)=@_;
134 0           $trndata=Net::DRI::Util::xml_traverse($trndata,$ns,'trnData');
135              
136 0           my $oname;
137 0           foreach my $el (Net::DRI::Util::xml_list_children($trndata))
138             {
139 0           my ($name,$c)=@$el;
140 0 0         if ($name eq 'domainname')
    0          
    0          
    0          
141             {
142 0           $oname=lc($c->textContent());
143             } elsif ($name eq 'requestor')
144             {
145 0           $rh->{requestor}=$c->textContent();
146             } elsif ($name eq 'requestDate')
147             {
148 0           $rh->{request_date}=$po->parse_iso8601($c->textContent());
149             } elsif ($name eq 'supplyDate')
150             {
151 0           $rh->{supply_date}=$po->parse_iso8601($c->textContent());
152             }
153             }
154 0           return $oname;
155             }
156              
157             sub supply_parse
158             {
159 0     0 0   my ($po,$trndata,$ns,$rh)=@_;
160 0           $trndata=Net::DRI::Util::xml_traverse($trndata,$ns,'trnData');
161              
162 0           my $oname;
163 0           foreach my $el (Net::DRI::Util::xml_list_children($trndata))
164             {
165 0           my ($name,$c)=@$el;
166 0 0         if ($name eq 'domainname')
    0          
    0          
167             {
168 0           $oname=lc($c->textContent());
169             } elsif ($name eq 'pw')
170             {
171 0           $rh->{token}=$c->textContent();
172             } elsif ($name eq 'requestDate')
173             {
174 0           $rh->{request_date}=$po->parse_iso8601($c->textContent());
175             }
176             }
177 0           return $oname;
178             }
179              
180             ####################################################################################################
181             1;
182              
183             __END__