File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/NO/Host.pm
Criterion Covered Total %
statement 9 150 6.0
branch 0 70 0.0
condition 0 36 0.0
subroutine 3 12 25.0
pod 0 8 0.0
total 12 276 4.3


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .NO Host extensions
2             ##
3             ## Copyright (c) 2008,2010,2013-2014 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::Host;
18              
19 1     1   3 use strict;
  1         2  
  1         21  
20 1     1   2 use warnings;
  1         1  
  1         17  
21              
22 1     1   2 use Net::DRI::Util;
  1         1  
  1         1077  
23              
24             =pod
25              
26             =head1 NAME
27              
28             Net::DRI::Protocol::EPP::Extensions::NO::Host - .NO Host Extensions for Net::DRI
29              
30             =head1 DESCRIPTION
31              
32             Please see the README file for details.
33              
34             =head1 SUPPORT
35              
36             For now, support questions should be sent to:
37              
38             Enetdri@dotandco.comE
39              
40             Please also see the SUPPORT file in the distribution.
41              
42             =head1 SEE ALSO
43              
44             Ehttp://www.dotandco.com/services/software/Net-DRI/E
45              
46             =head1 AUTHOR
47              
48             Trond Haugen, Einfo@norid.noE
49              
50             =head1 COPYRIGHT
51              
52             Copyright (c) 2008,2010,2013-2014 UNINETT Norid AS, Ehttp://www.norid.noE,
53             Trond Haugen Einfo@norid.noE
54             All rights reserved.
55              
56             This program is free software; you can redistribute it and/or modify
57             it under the terms of the GNU General Public License as published by
58             the Free Software Foundation; either version 2 of the License, or
59             (at your option) any later version.
60              
61             See the LICENSE file that comes with this distribution for more details.
62              
63             =cut
64              
65             ####################################################################################################
66              
67             sub register_commands {
68 0     0 0   my ( $class, $version ) = @_;
69 0           my %tmp = (
70             create => [ \&create, undef ],
71             update => [ \&update, undef ],
72             delete => [ \&facet, undef ],
73             check => [ \&facet, undef ],
74             info => [ \&info, \&parse_info ],
75             );
76              
77 0           return { 'host' => \%tmp };
78             }
79              
80             ####################################################################################################
81              
82             #####
83             # Facets
84             #
85              
86             sub _build_facet_extension {
87 0     0     my ( $mes, $epp, $tag ) = @_;
88              
89 0           return $mes->command_extension_register(
90             $tag,
91             sprintf(
92             'xmlns:no-ext-epp="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('no_epp')
93             )
94             );
95             }
96              
97             ##
98             # This facet method is generic and can be called from all object operations
99             #
100             sub build_facets {
101 0     0 0   my ( $epp, $rd ) = @_;
102              
103 0           my @e;
104             my $eid;
105              
106 0           my $mes = $epp->message();
107 0 0 0       if (exists($rd->{facets}) && defined($rd->{facets})) {
108 0           $eid = _build_facet_extension( $mes, $epp, 'no-ext-epp:extended' );
109 0           foreach my $fkey (sort { $a cmp $b } keys(%{$rd->{facets}})) {
  0            
  0            
110 0           push @e, [ 'no-ext-epp:facet', { name => $fkey }, $rd->{facets}->{$fkey} ];
111             }
112             }
113 0 0         return $mes->command_extension( $eid, \@e ) if (@e);
114 0           return;
115             }
116              
117              
118             sub facet {
119 0     0 0   my ( $epp, $o, $rd ) = @_;
120              
121 0           return build_facets( $epp, $rd );
122             }
123              
124              
125             sub parse_info {
126 0     0 0   my ( $po, $otype, $oaction, $oname, $rinfo ) = @_;
127 0           my $mes = $po->message();
128 0 0         return unless $mes->is_success();
129              
130 0           my $NS = $mes->ns('no_host');
131              
132 0           my $condata = $mes->get_extension('no_host','infData');
133 0 0         return unless $condata;
134              
135 0           my @e = $condata->getElementsByTagNameNS( $NS, 'contact' );
136 0 0         return unless @e;
137              
138             # Contact is optional, may be single or multiple,
139             # return the contactIDs in an ARRAY
140 0           my @hc;
141 0           foreach my $el ( @e)
142             {
143 0           my $c = $el->getFirstChild();
144 0           my $v;
145 0 0         $v = $c->getData() if ($c);
146 0 0         push @hc, $v if ($v);
147             }
148 0 0         if ( @hc > 0 ) {
149             # multiple, return array
150 0           push @{$rinfo->{host}->{$oname}->{contact}}, @hc;
  0            
151             }
152 0           return;
153             }
154              
155             sub build_command_extension {
156 0     0 0   my ( $mes, $epp, $tag ) = @_;
157              
158 0           return $mes->command_extension_register(
159             $tag,
160             sprintf(
161             'xmlns:no-ext-host="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('no_host')
162             )
163             );
164             }
165              
166              
167              
168             sub info {
169 0     0 0   my ( $epp, $ho, $rd ) = @_;
170 0           my $mes = $epp->message();
171              
172 0           my $si;
173 0 0         $si = $rd->{sponsoringclientid} if (exists($rd->{sponsoringclientid}));
174 0           my $fs;
175 0 0         $fs = $rd->{facets} if (exists($rd->{facets}));
176              
177 0 0 0       return unless ( $si || $fs );
178              
179 0           my $r;
180              
181 0 0         if ($si) {
182 0           my $eid = build_command_extension( $mes, $epp, 'no-ext-host:info' );
183 0           my @e;
184 0           push @e, [ 'no-ext-host:sponsoringClientID', $si ];
185 0           $r = $mes->command_extension( $eid, \@e );
186             }
187 0 0         if ($fs) {
188 0           $r = facet( $epp, $ho, $rd );
189             }
190            
191 0           return $r;
192             }
193              
194             sub create {
195 0     0 0   my ( $epp, $ho, $rd ) = @_;
196 0           my $mes = $epp->message();
197              
198 0 0 0       return unless ((exists($rd->{contact}) && defined($rd->{contact})) || (exists($rd->{facets}) && defined($rd->{facets})));
      0        
      0        
199              
200 0           my $r;
201              
202 0 0 0       if (exists($rd->{contact}) && defined($rd->{contact})) {
203 0           my @e;
204 0           my $eid = build_command_extension( $mes, $epp, 'no-ext-host:create' );
205 0           my $c = $rd->{contact};
206 0           my $srid;
207            
208 0 0         if ( ref($c) eq 'ARRAY' ) {
209 0           foreach my $cn (@$c) {
210 0 0         if (Net::DRI::Util::isa_contact($cn))
211             {
212 0           $srid = $cn->srid();
213             } else {
214 0           $srid = $cn;
215             }
216 0           push @e, [ 'no-ext-host:contact', $srid ];
217             }
218             } else {
219             # $c may be a contact set, contact object or a direct scalar
220 0           my @contacts;
221 0 0         if (Net::DRI::Util::isa_contactset($c)) {
    0          
222 0           foreach my $cn (sort { $a cmp $b } keys %{ $$c{'c'} } ) {
  0            
  0            
223 0           push @contacts, ${$$c{'c'}}{$cn}->[0]->srid();
  0            
224             }
225             } elsif (Net::DRI::Util::isa_contact($c)) {
226 0           @contacts = $c->srid();
227             } else {
228 0           @contacts = $c;
229             }
230 0           foreach my $srid (@contacts) {
231 0           push @e, [ 'no-ext-host:contact', $srid ];
232             }
233             }
234 0           $r = $mes->command_extension( $eid, \@e );
235             }
236              
237             # Add facet if any is set
238 0 0 0       if (exists($rd->{facets}) && defined($rd->{facets})) {
239 0           $r = facet( $epp, $ho, $rd );
240             }
241              
242 0           return $r;
243             }
244              
245             sub update {
246 0     0 0   my ( $epp, $ho, $todo ) = @_;
247 0           my $mes = $epp->message();
248              
249 0           my $ca = $todo->add('contact');
250 0           my $cd = $todo->del('contact');
251 0           my $fs = $todo->set('facets');
252              
253 0 0 0       return unless ( $ca || $cd || $fs); # No updates asked
      0        
254              
255 0           my $r;
256              
257 0 0 0       if ( $ca || $cd ) {
258 0           my $eid = build_command_extension( $mes, $epp, 'no-ext-host:update' );
259              
260 0           my ( @n, @e, $c, $srid );
261              
262 0 0 0       if ( defined($ca) && $ca ) {
263 0           $c = $ca;
264 0 0         if ( ref($c) eq 'ARRAY' ) {
265 0           foreach my $cn (@$c) {
266 0 0         if (Net::DRI::Util::isa_contact($cn))
267             {
268 0           $srid = $cn->srid();
269             } else {
270 0           $srid = $cn;
271             }
272 0           push @e, [ 'no-ext-host:contact', $srid ];
273             }
274             } else {
275             # $c may be a contact set, contact object or a direct scalar
276 0           my @contacts;
277 0 0         if (Net::DRI::Util::isa_contactset($c)) {
    0          
278 0           foreach my $cn (sort { $a cmp $b } keys %{ $$c{'c'} } ) {
  0            
  0            
279 0           push @contacts, ${$$c{'c'}}{$cn}->[0]->srid();
  0            
280             }
281             } elsif (Net::DRI::Util::isa_contact($c)) {
282 0           @contacts = $c->srid();
283             } else {
284 0           @contacts = $c;
285             }
286 0           foreach my $srid (@contacts) {
287 0           push @e, [ 'no-ext-host:contact', $srid ];
288             }
289             }
290              
291 0 0         push @n, [ 'no-ext-host:add', @e ] if ( @e > 0 );
292             }
293 0           @e = undef;
294 0 0 0       if ( defined($cd) && $cd ) {
295              
296 0           $c = $cd;
297 0 0         if ( ref($c) eq 'ARRAY' ) {
298 0           foreach my $cn (@$c) {
299 0 0         if (Net::DRI::Util::isa_contact($cn))
300             {
301 0           $srid = $cn->srid();
302             } else {
303 0           $srid = $cn;
304             }
305 0           push @e, [ 'no-ext-host:contact', $srid ];
306             }
307             } else {
308             # $c may be a contact set, contact object or a direct scalar
309 0           my @contacts;
310 0 0         if (Net::DRI::Util::isa_contactset($c)) {
    0          
311 0           foreach my $cn (sort { $a cmp $b } keys %{ $$c{'c'} } ) {
  0            
  0            
312 0           push @contacts, ${$$c{'c'}}{$cn}->[0]->srid();
  0            
313             }
314             } elsif (Net::DRI::Util::isa_contact($c)) {
315 0           @contacts = $c->srid();
316             } else {
317 0           @contacts = $c;
318             }
319 0           foreach my $srid (@contacts) {
320 0           push @e, [ 'no-ext-host:contact', $srid ];
321             }
322             }
323 0 0         push @n, [ 'no-ext-host:rem', @e ] if ( @e > 0 );
324             }
325 0           $r = $mes->command_extension( $eid, \@n );
326             }
327              
328             # Add facet if any is set
329 0 0         if ($fs) {
330 0           my $rd;
331 0           $rd->{facets} = $fs;
332 0           $r = facet( $epp, $ho, $rd );
333             }
334 0           return $r;
335             }
336              
337             ####################################################################################################
338             1;