File Coverage

blib/lib/Net/DRI/Protocol/IRIS/DCHK/Domain.pm
Criterion Covered Total %
statement 21 92 22.8
branch 0 48 0.0
condition 0 9 0.0
subroutine 7 12 58.3
pod 0 5 0.0
total 28 166 16.8


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, IRIS DCHK (RFC5144)
2             ##
3             ## Copyright (c) 2008,2010-2011,2013 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::IRIS::DCHK::Domain;
16              
17 1     1   710 use utf8;
  1         2  
  1         4  
18 1     1   26 use strict;
  1         2  
  1         22  
19 1     1   4 use warnings;
  1         1  
  1         19  
20              
21 1     1   4 use Carp;
  1         1  
  1         45  
22              
23 1     1   4 use Net::DRI::Util;
  1         2  
  1         21  
24 1     1   3 use Net::DRI::Exception;
  1         2  
  1         27  
25 1     1   4 use Net::DRI::Protocol::IRIS::Core;
  1         1  
  1         960  
26              
27             =pod
28              
29             =head1 NAME
30              
31             Net::DRI::Protocol::IRIS::DCHK::Domain - IRIS DCHK (RFC5144) Domain Commands for Net::DRI
32              
33             =head1 DESCRIPTION
34              
35             Please see the README file for details.
36              
37             =head1 SUPPORT
38              
39             For now, support questions should be sent to:
40              
41             Enetdri@dotandco.comE
42              
43             Please also see the SUPPORT file in the distribution.
44              
45             =head1 SEE ALSO
46              
47             Ehttp://www.dotandco.com/services/software/Net-DRI/E
48              
49             =head1 AUTHOR
50              
51             Patrick Mevzek, Enetdri@dotandco.comE
52              
53             =head1 COPYRIGHT
54              
55             Copyright (c) 2008,2010-2011,2013 Patrick Mevzek .
56             All rights reserved.
57              
58             This program is free software; you can redistribute it and/or modify
59             it under the terms of the GNU General Public License as published by
60             the Free Software Foundation; either version 2 of the License, or
61             (at your option) any later version.
62              
63             See the LICENSE file that comes with this distribution for more details.
64              
65             =cut
66              
67             ####################################################################################################
68              
69             sub register_commands
70             {
71 0     0 0   my ($class,$version)=@_;
72 0           my %tmp=( info => [ \&info, \&info_parse ] );
73             ## $tmp{info_multi}=$tmp{info};
74 0           return { 'domain' => \%tmp };
75             }
76              
77             sub build_command
78             {
79 0     0 0   my ($ns,$domain)=@_;
80 0 0         my @dom=ref $domain ? @$domain : ($domain);
81 0 0         Net::DRI::Exception->die(1,'protocol/IRIS',2,'Domain name needed') unless @dom;
82 0           foreach my $d (@dom)
83             {
84 0 0 0       Net::DRI::Exception->die(1,'protocol/IRIS',2,'Domain name needed') unless defined $d && $d;
85 0 0         Net::DRI::Exception->die(1,'protocol/IRIS',10,'Invalid domain name: '.$d) unless Net::DRI::Util::is_hostname($d);
86             }
87              
88             ## TODO: entityClass may also be IDN for Unicode domain names ## §3.1.2
89             ##return [ map { { registryType => $ns, entityClass => 'domain-name', entityName => $_ } } @dom ] ;
90 0           return [ map { { registryType => 'dchk1', entityClass => 'domain-name', entityName => $_ } } @dom ] ; ## Both registryType forms should work, but currently only this one works
  0            
91             }
92              
93             sub info
94             {
95 0     0 0   my ($p,$domain)=@_;
96 0           my $mes=$p->message();
97 0           $mes->search(build_command($mes->ns('dchk1'),$domain));
98 0           return;
99             }
100              
101             sub info_parse
102             {
103 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
104 0           my $mes=$po->message();
105 0 0         return unless $mes->is_success(); ## ?
106 0 0         return unless $mes->results(); ## a nodeList of resultSet nodes
107              
108 0           foreach my $cd ($mes->results()->get_nodelist())
109             {
110 0 0         carp('For domain '.$oname.' got a node , please report') if $cd->getChildrenByTagNameNS($mes->ns('iris1'),'additional')->size(); ## TODO
111 0           $rinfo->{domain}->{$oname}->{result_status}=Net::DRI::Protocol::IRIS::Core::parse_error($cd); ## a ResultStatus instance, either a generic success, or a specific error
112 0           $rinfo->{domain}->{$oname}->{action}='info';
113 0           $rinfo->{domain}->{$oname}->{exist}=0;
114              
115 0           my $c=$cd->getChildrenByTagNameNS($mes->ns('iris1'),'answer');
116 0 0         next unless $c->size();
117 0           $c=$c->get_node(1)->getChildrenByTagNameNS($mes->ns('dchk1'),'domain');
118 0 0         next unless $c->size();
119             ## We do not parse attributes authority/entityClass/entityName/registryType, they should be the same as what we sent
120 0           $c=$c->get_node(1);
121 0 0         my $temp=$c->hasAttribute('temporaryReference')? Net::DRI::Util::xml_parse_boolean($c->getAttribute('temporaryReference')) : 0;
122              
123 0           my ($domain,@s);
124 0           foreach my $el (Net::DRI::Util::xml_list_children($c))
125             {
126 0           my ($n,$c)=@$el;
127 0 0 0       if ($n eq 'domainName') ## we do not use for now
    0          
    0          
    0          
    0          
    0          
    0          
    0          
128             {
129 0           $domain=lc($c->textContent());
130 0           $rinfo->{domain}->{$domain}->{action}='info';
131             } elsif ($n eq 'status')
132             {
133             ## We take everything below as a status node, which allows us to handle all non RFC5144 defined statuses
134 0           foreach my $el (Net::DRI::Util::xml_list_children($c))
135             {
136 0           my ($nn,$cc)=@$el;
137 0           push @s,parse_status($po,$cc);
138             }
139             } elsif ($n eq 'registrationReference')
140             {
141 0           carp('For domain '.$domain.' got a node , please report');
142             } elsif ($n eq 'createdDateTime')
143             {
144 0           $rinfo->{domain}->{$domain}->{crDate}=$po->parse_iso8601($c->textContent());
145             } elsif ($n eq 'initialDelegationDateTime')
146             {
147 0           $rinfo->{domain}->{$domain}->{idDate}=$po->parse_iso8601($c->textContent());
148             } elsif ($n eq 'expirationDateTime')
149             {
150 0           $rinfo->{domain}->{$domain}->{exDate}=$po->parse_iso8601($c->textContent());
151             } elsif ($n eq 'lastDatabaseUpdateDateTime')
152             {
153 0           $rinfo->{domain}->{$domain}->{duDate}=$po->parse_iso8601($c->textContent());
154             } elsif ($n eq 'seeAlso' || $n eq 'iris:seeAlso')
155             {
156 0           carp('For domain '.$domain.' got a node <'.$n.'>, please report');
157             }
158             }
159              
160 0           $rinfo->{domain}->{$domain}->{temporary}=$temp;
161 0           $rinfo->{domain}->{$domain}->{status}=$po->create_local_object('status')->add(@s);
162 0 0 0       $rinfo->{domain}->{$domain}->{exist}=1 if $rinfo->{domain}->{$oname}->{result_status}->is_success() && $rinfo->{domain}->{$domain}->{status}->has_any(qw/active inactive/);
163             } ## end of foreach on each resultSet
164 0           return;
165             }
166              
167             sub parse_status ## §3.1.1.1
168             {
169 0     0 0   my ($po,$node)=@_;
170 0           my %tmp=(name => $node->localname() );
171 0           my $ns=$node->namespaceURI();
172              
173 0           my $c=$node->getChildrenByTagNameNS($ns,'appliedDate'); ## 0..1
174 0 0         $tmp{applied_date}=$po->parse_iso8601($c->get_node(1)->textContent()) if $c->size();
175              
176 0           $c=$node->getChildrenByTagNameNS($ns,'ticket'); ## 0..unbounded
177 0 0         $tmp{tickets}=[ map { $_->textContent() } $c->get_nodelist() ] if $c->size();
  0            
178              
179 0           $c=$node->getChildrenByTagNameNS($ns,'description'); ## 0..unbounded
180 0 0         if ($c->size())
181             {
182 0           my @t=map { { lang => $_->getAttribute('language'), msg => $_->textContent() } } $c->get_nodelist();
  0            
183 0           $tmp{description}=\@t;
184              
185             ## Useful fallback to mimick EPP ?
186 0           $tmp{lang}=$t[0]->{lang};
187 0           $tmp{msg}=$t[0]->{msg};
188             }
189              
190 0           $c=$node->getChildrenByTagNameNS($ns,'subStatus'); ## 0..unbounded ; not defined by RFC5144
191 0 0         $tmp{substatus}=[ map { { authority => $_->getAttribute('authority'), content => $_->textContent() } } $c->get_nodelist() ] if $c->size();
  0            
192              
193 0           foreach my $a (qw/actor disposition scope/)
194             {
195 0 0         next unless $node->hasAttribute($a);
196 0           $tmp{$a}=$node->getAttribute($a);
197             }
198              
199 0           return \%tmp;
200             }
201              
202             ####################################################################################################
203             1;