File Coverage

blib/lib/Net/DRI/Protocol/RRI/Contact.pm
Criterion Covered Total %
statement 15 246 6.1
branch 0 152 0.0
condition 0 38 0.0
subroutine 5 22 22.7
pod 0 16 0.0
total 20 474 4.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, RRI Contact commands (DENIC-11)
2             ##
3             ## Copyright (c) 2007,2008,2009 Tonnerre Lombard . All rights reserved.
4             ## (c) 2012,2013 Michael Holloway . All rights reserved.
5             ##
6             ## This file is part of Net::DRI
7             ##
8             ## Net::DRI is free software; you can redistribute it and/or modify
9             ## it under the terms of the GNU General Public License as published by
10             ## the Free Software Foundation; either version 2 of the License, or
11             ## (at your option) any later version.
12             ##
13             ## See the LICENSE file that comes with this distribution for more details.
14             ####################################################################################################
15              
16             package Net::DRI::Protocol::RRI::Contact;
17              
18 1     1   648 use strict;
  1         2  
  1         23  
19 1     1   3 use warnings;
  1         1  
  1         17  
20              
21 1     1   3 use Net::DRI::Util;
  1         1  
  1         13  
22 1     1   3 use Net::DRI::Exception;
  1         2  
  1         20  
23              
24 1     1   3 use DateTime::Format::ISO8601 ();
  1         1  
  1         2019  
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Protocol::RRI::Contact - RRI Contact commands (DENIC-11) 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             Etonnerre.lombard@sygroup.chE
41              
42             Please also see the SUPPORT file in the distribution.
43              
44             =head1 SEE ALSO
45              
46             Ehttp://oss.bsdprojects.net/projects/netdri/E
47              
48             =head1 AUTHOR
49              
50             Tonnerre Lombard, Etonnerre.lombard@sygroup.chE
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2007,2008,2009 Tonnerre Lombard .
55             (c) 2012,2013 Michael Holloway . All rights reserved.
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=(
73             check => [ \&check, \&check_parse ],
74             info => [ \&info, \&info_parse ],
75             create => [ \&create, \&create_parse ],
76             update => [ \&update ],
77             );
78              
79             ##$tmp{check_multi}=$tmp{check};
80 0           return { 'contact' => \%tmp };
81             }
82              
83             sub build_command
84             {
85 0     0 0   my ($msg, $command, $contact) = @_;
86 0 0         my @contact = (ref($contact) eq 'ARRAY')? @$contact : ($contact);
87 0 0         my @c = map { Net::DRI::Util::isa_contact($_)? $_->srid() : $_ }
  0            
88             @contact;
89              
90 0 0         Net::DRI::Exception->die(1,'protocol/RRI',2,'Contact id needed') unless @c;
91 0           foreach my $n (@c)
92             {
93 0 0 0       Net::DRI::Exception->die(1,'protocol/RRI',2,'Contact id needed') unless defined($n) && $n;
94 0 0         Net::DRI::Exception->die(1,'protocol/RRI',10,'Invalid contact id: '.$n) unless Net::DRI::Util::xml_is_token($n,3,32);
95             }
96              
97 0 0         my $tcommand = (ref($command))? $command->[0] : $command;
98 0           my @ns = @{$msg->ns->{contact}};
  0            
99 0           $msg->command(['contact',$tcommand,$ns[0]]);
100              
101 0           my @d = map { ['contact:handle',$_] } @c;
  0            
102              
103 0           return @d;
104             }
105              
106             ####################################################################################################
107             ########### Query commands
108              
109             sub check
110             {
111 0     0 0   my ($rri,$c)=@_;
112 0           my $mes=$rri->message();
113 0           my @d=build_command($mes,'check',$c);
114 0           $mes->command_body(\@d);
115 0           $mes->cltrid(undef);
116 0           return;
117             }
118              
119             sub check_parse
120             {
121 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
122 0           my $mes = $po->message();
123 0 0         return unless $mes->is_success();
124              
125 0           my $chkdata = $mes->get_content('checkData',$mes->ns('contact'));
126 0 0         return unless ($chkdata);
127 0           my @c = $chkdata->getElementsByTagNameNS($mes->ns('contact'),'handle');
128 0           my @s = $chkdata->getElementsByTagNameNS($mes->ns('contact'),'status');
129 0 0 0       return unless (@c && @s);
130 0           my $contact = $c[0]->getFirstChild()->getData();
131 0           $rinfo->{contact}->{$contact}->{action} = 'check';
132 0 0         $rinfo->{contact}->{$contact}->{exist} = ($s[0]->getFirstChild()->getData() eq 'free')? 0 : 1;
133 0           return;
134             }
135              
136             sub info
137             {
138 0     0 0   my ($rri,$c)=@_;
139 0           my $mes=$rri->message();
140 0           my @d=build_command($mes,'info',$c);
141 0           $mes->command_body(\@d);
142 0           $mes->cltrid(undef);
143 0           return;
144             }
145              
146             sub info_parse
147             {
148 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
149 0           my $mes=$po->message();
150 0 0         return unless $mes->is_success();
151              
152 0           my $infdata=$mes->get_content('infoData',$mes->ns('contact'));
153 0 0         return unless $infdata;
154              
155 0           my %cd=map { $_ => [] } qw/name org street city sp pc cc/;
  0            
156 0           my $contact=$po->create_local_object('contact');
157 0           my @s;
158 0           my $c=$infdata->getFirstChild();
159 0           while ($c)
160             {
161 0 0         next unless ($c->nodeType() == 1);
162 0   0       my $name=$c->localname() || $c->nodeName();
163 0 0         next unless $name;
164 0 0         if ($name eq 'handle')
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
165             {
166 0           my $clID;
167 0           $oname = $c->getFirstChild()->getData();
168 0 0         if ($oname =~ /^(\w+)-(\d+)-/)
169 0           { $clID = $1 . '-' . $2 . '-RRI'; }
170 0           $rinfo->{contact}->{$oname}->{action} = 'info';
171 0           $rinfo->{contact}->{$oname}->{exist} = 1;
172             $rinfo->{contact}->{$oname}->{clID} =
173 0           $rinfo->{contact}->{$oname}->{crID} = $clID;
174 0           $contact->srid($oname);
175             } elsif ($name eq 'roid')
176             {
177 0           my $el = $c->getFirstChild();
178 0 0         $contact->roid($el->getData()) if (defined($el));
179 0           $rinfo->{contact}->{$oname}->{roid} = $contact->roid();
180             } elsif ($name eq 'changed')
181             {
182 0           my $el = $c->getFirstChild();
183             $rinfo->{contact}->{$oname}->{upDate} =
184             $rinfo->{contact}->{$oname}->{crDate} =
185 0 0         DateTime::Format::ISO8601->new()->
186             parse_datetime($c->getFirstChild()->getData()) if (defined($el));
187             } elsif ($name eq 'type')
188             {
189 0           my $el = $c->getFirstChild();
190 0 0         $contact->type($el->getData()) if (defined($el));
191             } elsif ($name eq 'email')
192             {
193 0           my $el = $c->getFirstChild();
194 0 0         $contact->email($el->getData()) if (defined($el));
195             } elsif ($name eq 'name')
196             {
197 0           my $el = $c->getFirstChild();
198 0 0         $contact->name($el->getData()) if (defined($el));
199             } elsif ($name eq 'organisation')
200             {
201 0           my $el = $c->getFirstChild();
202 0 0         $contact->org($el->getData()) if (defined($el));
203             } elsif ($name eq 'sip')
204             {
205 0           my $el = $c->getFirstChild();
206 0 0         $contact->sip($el->getData()) if (defined($el));
207             } elsif ($name eq 'remarks')
208             {
209 0           my $el = $c->getFirstChild();
210 0 0         $contact->remarks($el->getData()) if (defined($el));
211             } elsif ($name eq 'phone')
212             {
213 0           $contact->voice(parse_tel($c));
214             } elsif ($name eq 'fax')
215             {
216 0           $contact->fax(parse_tel($c));
217             } elsif ($name eq 'postal')
218             {
219 0           parse_postalinfo($c,\%cd);
220             } elsif ($name eq 'disclose')
221             {
222 0           $contact->disclose(parse_disclose($c));
223             }
224 0           } continue { $c=$c->getNextSibling(); }
225              
226 0           $contact->street(@{$cd{street}});
  0            
227 0           $contact->city(@{$cd{city}});
  0            
228 0           $contact->pc(@{$cd{pc}});
  0            
229 0           $contact->cc(@{$cd{cc}});
  0            
230              
231 0           $rinfo->{contact}->{$oname}->{self}=$contact;
232 0           return;
233             }
234              
235             sub parse_tel
236             {
237 0     0 0   my $node=shift;
238 0   0       my $ext=$node->getAttribute('x') || '';
239 0           my $num=get_data($node);
240 0 0         $num.='x'.$ext if $ext;
241 0           return $num;
242             }
243              
244             sub get_data
245             {
246 0     0 0   my $n=shift;
247 0 0         return ($n->getFirstChild())? $n->getFirstChild()->getData() : '';
248             }
249              
250             sub parse_postalinfo
251             {
252 0     0 0   my ($c,$rcd)=@_;
253 0           my @street;
254 0           my $n = $c->getFirstChild();
255              
256 0           while ($n)
257             {
258 0 0         next unless ($n->nodeType() == 1);
259 0   0       my $name=$n->localname() || $n->nodeName();
260 0 0         next unless $name;
261 0 0         if ($name eq 'city')
    0          
    0          
    0          
262             {
263 0           $rcd->{city}->[0] = get_data($n);
264             } elsif ($name eq 'postalCode')
265             {
266 0           $rcd->{pc}->[0] = get_data($n);
267             } elsif ($name eq 'countryCode')
268             {
269 0           $rcd->{cc}->[0] = get_data($n);
270             } elsif ($name eq 'address')
271             {
272 0           push @street, get_data($n);
273             }
274 0           } continue { $n=$n->getNextSibling(); }
275              
276 0           $rcd->{street}->[0]=\@street;
277 0           return;
278             }
279              
280             sub parse_disclose
281             {
282 0     0 0   my $c=shift;
283 0           my $flag=Net::DRI::Util::xml_parse_boolean($c->getAttribute('flag'));
284 0           my %tmp;
285 0           my $n=$c->getFirstChild();
286 0           while($n)
287             {
288 0 0         next unless ($n->nodeType() == 1);
289 0   0       my $name=$n->localname() || $n->nodeName();
290 0 0         next unless $name;
291 0 0         if ($name=~m/^(name|org|addr)$/)
    0          
292             {
293 0           my $t=$n->getAttribute('type');
294 0           $tmp{$1.'_'.$t}=$flag;
295             } elsif ($name=~m/^(voice|fax|email)$/)
296             {
297 0           $tmp{$1}=$flag;
298             }
299 0           } continue { $n=$n->getNextSibling(); }
300 0           return \%tmp;
301             }
302              
303             ############ Transform commands
304              
305             sub build_tel
306             {
307 0     0 0   my ($name,$tel)=@_;
308 0 0         if ($tel=~m/^(\S+)x(\S+)$/)
309             {
310 0           return [$name,$1,{x=>$2}];
311             } else
312             {
313 0           return [$name,$tel];
314             }
315             }
316              
317             sub build_disclose
318             {
319 0     0 0   my $contact=shift;
320 0           my $ref = shift;
321 0           my @d = @$ref;
322 0           my $ds=$contact->disclose();
323 0 0 0       return () unless ($ds && ref($ds));
324 0           foreach (@d) {
325 0           my ($c,$key) = split /:/, @{$_}[0];
  0            
326 0 0         $key = 'voice' if $key eq 'phone';
327 0 0 0       push @{$_}, { disclose => 'true'} if (defined($ds->{$key}) && $ds->{$key}==1);
  0            
328             }
329 0           return;
330             }
331              
332             sub build_cdata
333             {
334 0     0 0   my $contact=shift;
335 0           my @d;
336              
337 0           my (@post,@addr);
338 0           _do_locint(\@post,$contact,'type','type');
339 0           _do_locint(\@post,$contact,'name','name');
340 0           _do_locint(\@post,$contact,'organisation','org');
341 0           _do_locint(\@addr,$contact,'address','street');
342 0           _do_locint(\@addr,$contact,'postalCode','pc');
343 0           _do_locint(\@addr,$contact,'city','city');
344 0           _do_locint(\@addr,$contact,'countryCode','cc');
345 0 0         push @post,['contact:postal',@addr] if @addr;
346              
347 0 0         push (@d,@post) if @post;
348              
349 0 0         push @d,build_tel('contact:phone',$contact->voice()) if defined($contact->voice());
350 0 0         push @d,build_tel('contact:fax',$contact->fax()) if defined($contact->fax());
351 0 0         push @d,['contact:email',$contact->email()] if defined($contact->email());
352 0 0         push @d,['contact:sip',$contact->sip()] if defined($contact->sip());
353 0 0         push @d,['contact:remarks', $contact->remarks()] if defined($contact->remarks());
354 0           build_disclose($contact,\@d);
355              
356 0           return @d;
357             }
358              
359             sub _do_locint
360             {
361 0     0     my ($r, $contact, $tagname, $what) = @_;
362 0           my @tmp = $contact->$what();
363 0           my $loaded = 0;
364 0 0         return unless (@tmp);
365 0 0         if ($what eq 'street')
366             {
367 0 0         if (defined($tmp[0]))
368             {
369 0           foreach (@{$tmp[0]})
  0            
370             {
371 0           push @$r,['contact:'.$tagname,$_];
372 0           $loaded = 1;
373             }
374             }
375 0 0 0       if (defined($tmp[1]) && !$loaded)
376             {
377 0           foreach (@{$tmp[1]})
  0            
378             {
379 0           push @$r,['contact:'.$tagname,$_];
380             }
381             }
382             } else
383             {
384 0 0         if (defined($tmp[0]))
385             {
386 0           push @$r,['contact:'.$tagname,$tmp[0]];
387 0           $loaded = 1;
388             }
389 0 0 0       if (defined($tmp[1]) && !$loaded)
390             {
391 0           push @$r,['contact:'.$tagname,$tmp[1]];
392             }
393             }
394 0           return;
395             }
396              
397             sub create
398             {
399 0     0 0   my ($rri,$contact)=@_;
400 0           my $mes=$rri->message();
401 0           my @d=build_command($mes,'create',$contact);
402              
403 0 0         Net::DRI::Exception->die(1,'protocol/RRI',10,'Invalid contact '.$contact) unless (Net::DRI::Util::isa_contact($contact));
404 0           $contact->validate(); ## will trigger an Exception if needed
405 0           push @d,build_cdata($contact);
406 0           $mes->command_body(\@d);
407 0           return;
408             }
409              
410             sub create_parse
411             {
412 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
413 0           my $mes=$po->message();
414 0 0         return unless $mes->is_success();
415              
416 0           my $credata=$mes->get_content('creData',$mes->ns('contact'));
417 0 0         return unless $credata;
418              
419 0           my $c=$credata->getFirstChild();
420 0           while ($c)
421             {
422 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
423 0   0       my $name=$c->localname() || $c->nodeName();
424 0 0         if ($name eq 'id')
    0          
425             {
426 0           my $new=$c->getFirstChild()->getData();
427 0 0 0       $rinfo->{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 !
428 0           $oname=$new;
429 0           $rinfo->{contact}->{$oname}->{id}=$oname;
430 0           $rinfo->{contact}->{$oname}->{action}='create';
431 0           $rinfo->{contact}->{$oname}->{exist}=1;
432             } elsif ($name=~m/^(crDate)$/)
433             {
434 0           $rinfo->{contact}->{$oname}->{$1}=DateTime::Format::ISO8601->new()->parse_datetime($c->getFirstChild()->getData());
435             }
436 0           } continue { $c=$c->getNextSibling(); }
437 0           return;
438             }
439              
440             sub update
441             {
442 0     0 0   my ($rri,$contact,$todo)=@_;
443 0           my $mes=$rri->message();
444              
445 0 0         Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);
446 0 0 0       if ((grep { ! /^(?:add|del)$/ } $todo->types('status')) ||
  0            
447 0           (grep { ! /^(?:set)$/ } $todo->types('info'))
448             )
449             {
450 0           Net::DRI::Exception->die(0,'protocol/RRI',11,'Only status add/del or info set available for contact');
451             }
452              
453 0           my @d=build_command($mes,'update',$contact);
454              
455 0           my $newc=$todo->set('info');
456 0 0         if ($newc)
457             {
458 0 0         Net::DRI::Exception->die(1,'protocol/RRI',10,'Invalid contact '.$newc) unless Net::DRI::Util::isa_contact($newc);
459 0           $newc->type($contact->type());
460 0           $newc->validate(1); ## will trigger an Exception if needed
461 0           push @d,build_cdata($newc);
462             }
463 0           $mes->command_body(\@d);
464 0           return;
465             }
466              
467             ####################################################################################################
468             1;