File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/NO/Contact.pm
Criterion Covered Total %
statement 15 189 7.9
branch 0 114 0.0
condition 0 156 0.0
subroutine 5 13 38.4
pod 0 8 0.0
total 20 480 4.1


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .NO Contact extensions
2             ##
3             ## Copyright (c) 2008,2010 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::Contact;
18              
19 1     1   1092 use strict;
  1         2  
  1         28  
20 1     1   4 use warnings;
  1         1  
  1         21  
21              
22 1     1   4 use Net::DRI::Util;
  1         2  
  1         20  
23 1     1   5 use Net::DRI::Protocol::EPP::Util;
  1         2  
  1         16  
24 1     1   377 use Net::DRI::Protocol::EPP::Extensions::NO::Host;
  1         2  
  1         1686  
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Protocol::EPP::Extensions::NO::Contact - .NO Contact Extensions for Net::DRI
31              
32             =head1 DESCRIPTION
33              
34             Please see the README file for details.
35              
36             =head1 SUPPORT
37              
38             For now, support questions should be sent to:
39              
40             Enetdri@dotandco.comE
41              
42             Please also see the SUPPORT file in the distribution.
43              
44             =head1 SEE ALSO
45              
46             Ehttp://www.dotandco.com/services/software/Net-DRI/E
47              
48             =head1 AUTHOR
49              
50             Trond Haugen, Einfo@norid.noE
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2008,2010 UNINETT Norid AS, Ehttp://www.norid.noE,
55             Trond Haugen Einfo@norid.noE
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 0     0 0   my ( $class, $version ) = @_;
71 0           my %tmp = (
72             check => [ \&facet, undef ],
73             info => [ \&facet, \&parse_info ],
74             delete => [ \&facet, undef ],
75             create => [ \&create, undef ],
76             update => [ \&update, undef ],
77              
78             );
79              
80 0           return { 'contact' => \%tmp };
81             }
82              
83             ####################################################################################################
84             # parsing by XML::LibXML::Element methods
85              
86             sub parse_xdisclose {
87 0     0 0   my $c = shift;
88              
89 0           my $flag = Net::DRI::Util::xml_parse_boolean( $c->getAttribute('flag') );
90              
91 0           my %tmp;
92 0           my $n = $c->getFirstChild();
93 0           while ($n) {
94 0 0         next unless ( $n->nodeType() == 1 );
95 0   0       my $name = $n->localname() || $n->nodeName();
96 0 0         next unless $name;
97 0 0         if ( $name =~ m/^(mobilePhone)$/mx ) {
98 0           $tmp{$1} = $flag;
99             }
100             } continue {
101 0           $n = $n->getNextSibling();
102             }
103 0           return \%tmp;
104             }
105              
106             sub parse_info {
107 0     0 0   my ( $po, $otype, $oaction, $oname, $rinfo ) = @_;
108 0           my $mes = $po->message();
109 0 0         return unless $mes->is_success();
110              
111 0           my $NS = $mes->ns('no_contact');
112              
113 0           my $c = $rinfo->{contact}->{$oname}->{self};
114              
115             # This method is called also on a message_retrieve, so make sure we have a contact info
116             # before checking the email value.
117 0 0 0       $c->email(undef)
      0        
118             if ( $otype eq 'contact'
119             && $oaction eq 'info'
120             && $c->email() eq 'n/a' );
121              
122 0           my $condata = $mes->get_extension('no_contact','infData');
123 0 0         return unless $condata;
124              
125             # type
126 0           my $el = $condata->getElementsByTagNameNS( $NS, 'type' )
127             ; # XML::LibXML::NodeList back
128 0 0         my $type = $el ? $el->get_node(1)->getFirstChild()->getData() : undef;
129 0 0 0       $c->type($type) if ( defined($type) && $type );
130 0           $rinfo->{contact}->{$oname}->{type} = $c->type();
131              
132             # identity, type and value
133 0           my @e = $condata->getElementsByTagNameNS( $NS, 'identity' );
134 0 0 0       if ( @e && $e[0] ) {
135 0           my $t = $e[0];
136 0           my $tv = $t->getAttribute('type');
137 0           $c->identity(
138             { type => $tv, value => $t->getFirstChild()->getData() } );
139 0           $rinfo->{contact}->{$oname}->{identity} = $c->identity();
140             }
141              
142             # mobilePhone
143 0           @e = $condata->getElementsByTagNameNS( $NS, 'mobilePhone' );
144 0 0 0       if ( @e && $e[0] ) {
145 0           $c->mobilephone(
146             Net::DRI::Protocol::EPP::Util::parse_tel( $e[0] ) );
147 0           $rinfo->{contact}->{$oname}->{identity} = $c->mobilephone();
148             }
149              
150             ############
151 0           my @ema;
152 0           foreach my $el ( $condata->getElementsByTagNameNS( $NS, 'email' ) ) {
153 0           my $c = $el->getFirstChild();
154              
155 0           my $v;
156 0 0         $v = $c->getData() if ($c);
157 0 0         push @ema, $v if ($v);
158             }
159 0 0         if ( @ema > 0 ) {
160 0           $c->xemail( \@ema );
161 0           $rinfo->{contact}->{$oname}->{xemail} = $c->xemail();
162             }
163              
164             # organization
165 0           my @oa;
166 0           foreach my $el ( $condata->getElementsByTagNameNS( $NS, 'organization' ) )
167             {
168 0           my $c = $el->getFirstChild();
169 0           my $v;
170 0 0         $v = $c->getData() if ($c);
171 0 0         push @oa, $v if ($v);
172             }
173 0 0         if ( @oa > 0 ) {
174 0           $c->organization( \@oa );
175 0           $rinfo->{contact}->{$oname}->{organization} = $c->organization();
176             }
177              
178             # roleContact
179 0           my @rca;
180 0           foreach my $el ( $condata->getElementsByTagNameNS( $NS, 'roleContact' ) )
181             {
182 0           my $c = $el->getFirstChild();
183 0           my $v;
184 0 0         $v = $c->getData() if ($c);
185 0 0         push @rca, $v if ($v);
186             }
187 0 0         if ( @rca > 0 ) {
188 0           $c->rolecontact( \@rca );
189 0           $rinfo->{contact}->{$oname}->{rolecontact} = $c->rolecontact();
190             }
191              
192             ########
193             # xtra, disclose flag for mobilephone
194 0           @e = ();
195 0           @e = $condata->getElementsByTagNameNS( $NS, 'disclose' );
196 0 0 0       if ( @e && $e[0] ) {
197 0           my $t = $e[0];
198 0           $c->xdisclose( parse_xdisclose($t) );
199 0           $rinfo->{contact}->{$oname}->{xdisclose} = $c->xdisclose();
200             }
201 0           return;
202             }
203              
204             sub facet {
205 0     0 0   my ( $epp, $o, $rd ) = @_;
206              
207 0           return Net::DRI::Protocol::EPP::Extensions::NO::Host::build_facets( $epp, $rd );
208             }
209              
210             sub build_command_extension {
211 0     0 0   my ( $mes, $epp, $tag ) = @_;
212              
213 0           return $mes->command_extension_register(
214             $tag,
215             sprintf(
216             'xmlns:no-ext-contact="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('no_contact')
217             )
218             );
219             }
220              
221             sub add_no_extensions {
222 0     0 0   my ( $epp, $contact, $op ) = @_;
223 0           my $mes = $epp->message();
224              
225 0           my $ty = $contact->type();
226 0           my $id = $contact->identity();
227 0           my $mp = $contact->mobilephone();
228 0           my $org = $contact->organization();
229 0           my $rc = $contact->rolecontact();
230 0           my $aem = $contact->xemail();
231 0           my $xd = $contact->xdisclose();
232 0           my $fs = $contact->facets();
233              
234             return
235 0 0 0       unless ( defined($ty)
      0        
      0        
      0        
      0        
      0        
236             || defined($id)
237             || defined($mp)
238             || defined($org)
239             || defined($rc)
240             || defined($aem)
241             || defined($fs)
242             );
243              
244              
245 0           my $eid = build_command_extension( $mes, $epp, 'no-ext-contact:' . $op );
246 0           my @e;
247              
248 0 0 0       push @e, [ 'no-ext-contact:type', $ty ] if ( defined($ty) && $ty );
249              
250             # Add identity extension if present.
251 0 0 0       if ( defined($id) && ($id)
      0        
      0        
      0        
252             && ( ref($id) eq 'HASH' )
253             && exists( $id->{type} )
254             && exists( $id->{value} ) )
255             {
256 0           push @e,
257             [
258             'no-ext-contact:identity', { type => $id->{type} },
259             $id->{value}
260             ];
261             }
262              
263             #mobile is an e164 number
264 0 0         push @e,
265             Net::DRI::Protocol::EPP::Util::build_tel(
266             'no-ext-contact:mobilePhone', $mp )
267             if defined($mp);
268              
269             # email
270 0 0 0       if ( defined($aem) && $aem ) {
271 0 0         if (ref($aem) eq 'ARRAY' ) {
272 0           foreach my $c (@$aem) {
273 0           push @e, [ 'no-ext-contact:email', $c ];
274             }
275             } else {
276            
277             # scalar
278 0           push @e, [ 'no-ext-contact:email', $aem ];
279             }
280             }
281              
282             #organization is a clID
283 0 0 0       if ( defined($org) && $org ) {
284 0 0         if ( ref($org) eq 'ARRAY' ) {
285 0           foreach my $c (@$org) {
286 0           push @e, [ 'no-ext-contact:organization', $c ];
287             }
288             } else {
289              
290             # scalar
291 0           push @e, [ 'no-ext-contact:organization', $org ];
292              
293             }
294             }
295              
296             #roleContact is a clID
297 0 0 0       if ( defined($rc) && $rc ) {
298 0 0         if ( ref($rc) eq 'ARRAY' ) {
299 0           foreach my $c (@$rc) {
300 0           push @e, [ 'no-ext-contact:roleContact', $c ];
301             }
302             } else {
303            
304             # scalar
305 0           push @e, [ 'no-ext-contact:roleContact', $rc ];
306            
307             }
308             }
309              
310             # xdisclose
311 0 0 0       if ( defined ($xd) && $xd && (ref($xd) eq 'HASH') && exists( $xd->{mobilePhone} ) ) {
      0        
      0        
312 0           my @d;
313 0           my %v = map { $_ => 1 } values(%$xd);
  0            
314 0 0         if (keys(%v) == 1) {
315             ## 1 or 0 as values, not both at same time
316 0           push @d, ['no-ext-contact:mobilePhone'];
317              
318 0           push @e,
319             [ 'no-ext-contact:disclose', @d, { flag => ( keys(%v) )[0] } ];
320             }
321             }
322 0           my $r = $mes->command_extension( $eid, \@e );
323              
324             # Add facet if any is set
325 0 0         if ($fs) {
326 0           my $rd;
327 0           $rd->{facets} = $fs;
328 0           $r = facet($epp, $contact, $rd);
329             }
330              
331 0           return $r;
332             }
333              
334             sub create {
335 0     0 0   my ( $epp, $contact ) = @_;
336 0           return add_no_extensions( $epp, $contact, 'create' );
337             }
338              
339             sub update {
340 0     0 0   my ( $epp, $co, $todo ) = @_;
341 0           my $mes = $epp->message();
342              
343 0           my $r;
344 0           my $mp = $todo->set('mobilephone');
345 0           my $id = $todo->set('identity');
346 0           my $xd = $todo->set('xdisclose');
347 0           my $fs = $todo->set('facets');
348              
349 0           my $orgtoadd = $todo->add('organization');
350 0           my $orgtodel = $todo->del('organization');
351              
352 0           my $rctoadd = $todo->add('rolecontact');
353 0           my $rctodel = $todo->del('rolecontact');
354              
355 0           my $xetoadd = $todo->add('xemail');
356 0           my $xetodel = $todo->del('xemail');
357              
358 0 0 0       return unless ( defined($mp)
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
359             || $id
360             || $orgtoadd
361             || $orgtodel
362             || $rctoadd
363             || $rctodel
364             || $xetoadd
365             || $xetodel
366             || $xd
367             || $fs);
368              
369 0 0 0       if ( defined($mp)
      0        
      0        
      0        
      0        
      0        
      0        
      0        
370             || $id
371             || $orgtoadd
372             || $orgtodel
373             || $rctoadd
374             || $rctodel
375             || $xetoadd
376             || $xetodel
377             || $xd) {
378              
379 0           my $eid = build_command_extension( $mes, $epp, 'no-ext-contact:update' );
380              
381 0           my ( @n, @s );
382              
383 0 0         if ( defined($mp) ) {
384 0           push @s,
385             Net::DRI::Protocol::EPP::Util::build_tel(
386             'no-ext-contact:mobilePhone', $mp );
387             }
388 0 0 0       if ( defined($id)
      0        
      0        
389             && ( ref($id) eq 'HASH' )
390             && exists( $id->{type} )
391             && exists( $id->{value} ) )
392             {
393 0           push @s,
394             [
395             'no-ext-contact:identity', { type => $id->{type} },
396             $id->{value}
397             ];
398             }
399              
400             # xdisclose
401 0 0 0       if ( ref($xd) && $xd ) {
402 0           my @d;
403 0           my %v = map { $_ => 1 } values(%$xd);
  0            
404 0 0         push @d, ['no-ext-contact:mobilePhone']
405             if exists( $xd->{mobilePhone} );
406 0           push @s,
407             [ 'no-ext-contact:disclose', @d, { flag => ( keys(%v) )[0] } ];
408             }
409 0 0         push @n, [ 'no-ext-contact:chg', @s ] if ( @s > 0 );
410              
411 0           @s = undef;
412 0 0 0       if ( ( defined($orgtoadd) || defined($rctoadd) || defined($xetoadd) )
      0        
      0        
413             && ( $rctoadd || $orgtoadd || $xetoadd ) )
414             {
415 0           push @s,
416 0 0         map { [ 'no-ext-contact:email', $_ ] }
    0          
417             ( ref($xetoadd) eq 'ARRAY' ) ? @$xetoadd : ($xetoadd)
418             if ($xetoadd);
419 0           push @s,
420 0 0         map { [ 'no-ext-contact:organization', $_ ] }
    0          
421             ( ref($orgtoadd) eq 'ARRAY' ) ? @$orgtoadd : ($orgtoadd)
422             if ($orgtoadd);
423 0           push @s,
424 0 0         map { [ 'no-ext-contact:roleContact', $_ ] }
    0          
425             ( ref($rctoadd) eq 'ARRAY' ) ? @$rctoadd : ($rctoadd)
426             if ($rctoadd);
427 0 0         push @n, [ 'no-ext-contact:add', @s ] if ( @s > 0 );
428             }
429 0           @s = undef;
430 0 0 0       if ( defined($orgtodel)
      0        
      0        
      0        
431             || defined( $rctodel || defined($xetoadd) )
432             && ( $rctodel || $orgtodel || $xetodel ) )
433             {
434 0           push @s,
435 0 0         map { [ 'no-ext-contact:email', $_ ] }
    0          
436             ( ref($xetodel) eq 'ARRAY' ) ? @$xetodel : ($xetodel)
437             if ($xetodel);
438 0           push @s,
439 0 0         map { [ 'no-ext-contact:organization', $_ ] }
    0          
440             ( ref($orgtodel) eq 'ARRAY' ) ? @$orgtodel : ($orgtodel)
441             if ($orgtodel);
442 0           push @s,
443 0 0         map { [ 'no-ext-contact:roleContact', $_ ] }
    0          
444             ( ref($rctodel) eq 'ARRAY' ) ? @$rctodel : ($rctodel)
445             if ($rctodel);
446 0 0         push @n, [ 'no-ext-contact:rem', @s ] if ( @s > 0 );
447             }
448 0           $r = $mes->command_extension( $eid, \@n );
449             }
450              
451 0 0         if ($fs) {
452 0           my $rd;
453 0           $rd->{facets} = $fs;
454 0           $r = facet($epp, $co, $rd);
455            
456             }
457 0           return $r;
458             }
459              
460             ####################################################################################################
461             1;