File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/CZ/Contact.pm
Criterion Covered Total %
statement 15 126 11.9
branch 0 78 0.0
condition 0 36 0.0
subroutine 5 13 38.4
pod 0 8 0.0
total 20 261 7.6


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .CZ Contact EPP extension commands
2             ##
3             ## Copyright (c) 2008,2010,2013 Tonnerre Lombard .
4             ## 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::EPP::Extensions::CZ::Contact;
17              
18 1     1   869 use strict;
  1         1  
  1         22  
19 1     1   3 use warnings;
  1         2  
  1         18  
20              
21 1     1   3 use Net::DRI::Exception;
  1         2  
  1         14  
22 1     1   3 use Net::DRI::Util;
  1         1  
  1         13  
23 1     1   3 use Net::DRI::Protocol::EPP::Util;
  1         1  
  1         1034  
24              
25             =pod
26              
27             =head1 NAME
28              
29             Net::DRI::Protocol::EPP::Extensions::CZ::Contact - .CZ EPP Contact extension commands for Net::DRI
30              
31             =head1 DESCRIPTION
32              
33             Please see the README file for details.
34              
35             =head1 SUPPORT
36              
37             For now, support questions should be sent to:
38              
39             Edevelopment@sygroup.chE
40              
41             Please also see the SUPPORT file in the distribution.
42              
43             =head1 SEE ALSO
44              
45             Ehttp://oss.bsdprojects.net/projects/netdri/E or
46             Ehttp://www.dotandco.com/services/software/Net-DRI/E
47              
48             =head1 AUTHOR
49              
50             Tonnerre Lombard, Etonnerre.lombard@sygroup.chE
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2008,2010,2013 Tonnerre Lombard .
55             All rights reserved.
56              
57             This program is free software; you can redistribute it and/or modify
58             it under the terms of the GNU General Public License as published by
59             the Free Software Foundation; either version 2 of the License, or
60             (at your option) any later version.
61              
62             See the LICENSE file that comes with this distribution for more details.
63              
64             =cut
65              
66             ####################################################################################################
67              
68             sub register_commands
69             {
70 0     0 0   my ($class, $version) = @_;
71 0           my %tmp = (
72             info => [ undef, \&info_parse ],
73             create => [ \&create, undef ],
74             update => [ \&update, undef ]
75             );
76              
77 0           return { 'contact' => \%tmp };
78             }
79              
80             ####################################################################################################
81              
82             sub build_command
83             {
84 0     0 0   my ($msg, $command, $contact) = @_;
85 0 0         my @contact = (ref($contact) eq 'ARRAY')? @$contact : ($contact);
86 0 0         my @c = map { Net::DRI::Util::isa_contact($_) ?
  0            
87             $_->srid() : $_ } @contact;
88              
89 0 0         Net::DRI::Exception->die(1,'protocol/EPP',2,'Contact id needed')
90             unless @c;
91 0           foreach my $n (@c)
92             {
93 0 0 0       Net::DRI::Exception->die(1, 'protocol/EPP', 2,
      0        
94             'Contact id needed') unless (defined($n) && $n && !ref($n));
95 0 0         Net::DRI::Exception->die(1, 'protocol/EPP', 10,
96             'Invalid contact id: ' . $n)
97             unless Net::DRI::Util::xml_is_token($n, 3, 16);
98             }
99              
100 0 0         my $tcommand = (ref($command)) ? $command->[0] : $command;
101 0           $msg->command([$command, 'contact:' . $tcommand,
102             sprintf('xmlns:contact="%s" xsi:schemaLocation="%s %s"',$msg->nsattrs('contact'))]);
103              
104 0           my @d = map { ['contact:id', $_] } @c;
  0            
105 0 0 0       if (($tcommand =~ m/^(?:info|transfer)$/) && ref($contact[0]) &&
      0        
106             Net::DRI::Util::isa_contact($contact[0]))
107             {
108 0           my $az = $contact[0]->auth();
109 0 0 0       if ($az && ref($az) && exists($az->{pw}))
      0        
110             {
111 0           push(@d, ['contact:authInfo', $az->{pw}]);
112             }
113             }
114              
115 0           return @d;
116             }
117              
118             ############ Query commands
119              
120             sub info_parse
121             {
122 0     0 0   my ($po, $otype, $oaction, $oname, $rinfo) = @_;
123 0           my $mes = $po->message();
124              
125 0 0         return unless $mes->is_success();
126              
127 0           my $infdata = $mes->get_response('contact','infData');
128 0 0         return unless $infdata;
129              
130 0           my $s = $rinfo->{contact}->{$oname}->{self};
131 0           my $el = $infdata->getElementsByTagNameNS($mes->ns('contact'),
132             'authInfo');
133 0           while (my $ai = $el->shift())
134             {
135 0 0 0       $s->auth({pw => $ai->getFirstChild()->getData()})
      0        
136             if (defined($ai) && defined($ai->getFirstChild()) &&
137             $ai->getFirstChild()->nodeType() == 3);
138             }
139 0           return;
140             }
141              
142             ############ Transform commands
143              
144             sub build_authinfo
145             {
146 0     0 0   my $contact = shift;
147 0           my $az = $contact->auth();
148 0 0 0       return () unless ($az && ref($az) && exists($az->{pw}));
      0        
149 0           return ['contact:authInfo', $az->{pw}];
150             }
151              
152             sub build_disclose
153             {
154 0     0 0   my $contact = shift;
155 0           my $d=$contact->disclose();
156 0 0 0       return () unless ($d && ref($d));
157 0           my %v=map { $_ => 1 } values(%$d);
  0            
158 0 0         return () unless (keys(%v)==1); ## 1 or 0 as values, not both at same time
159              
160 0           my @d;
161 0 0         push(@d, ['contact:name']) if (exists($d->{name}));
162 0 0         push(@d, ['contact:org']) if (exists($d->{org}));
163 0 0         push(@d, ['contact:addr']) if (exists($d->{addr}));
164 0 0         push(@d, ['contact:voice']) if (exists($d->{voice}));
165 0 0         push(@d, ['contact:fax']) if (exists($d->{fax}));
166 0 0         push(@d, ['contact:email']) if (exists($d->{email}));
167              
168 0           return ['contact:disclose',@d,{flag=>(keys(%v))[0]}];
169             }
170              
171             sub build_cdata
172             {
173 0     0 0   my ($contact, $v) = @_;
174 0           my (@post, @addr);
175 0           my @tmp;
176 0           my @d;
177              
178 0           @tmp = $contact->name();
179 0 0         if (defined($tmp[0])) { push(@post, ['contact:name', $tmp[0]]); }
  0            
180              
181 0           @tmp = $contact->org();
182 0 0         if (defined($tmp[0])) { push(@post, ['contact:org', $tmp[0]]); }
  0            
183              
184 0           @tmp = $contact->street();
185 0 0         if (defined($tmp[0])) { foreach (@{$tmp[0]}) {
  0            
  0            
186 0           push(@addr, ['contact:street', $_]);
187             } }
188              
189 0           @tmp = $contact->city();
190 0 0         if (defined($tmp[0])) { push(@addr, ['contact:city', $tmp[0]]); }
  0            
191              
192 0           @tmp = $contact->sp();
193 0 0         if (defined($tmp[0])) { push(@addr, ['contact:sp', $tmp[0]]); }
  0            
194              
195 0           @tmp = $contact->pc();
196 0 0         if (defined($tmp[0])) { push(@addr, ['contact:pc', $tmp[0]]); }
  0            
197              
198 0           @tmp = $contact->cc();
199 0 0         if (defined($tmp[0])) { push(@addr, ['contact:cc', $tmp[0]]); }
  0            
200              
201 0 0         push(@post, ['contact:addr', @addr]) if (@addr);
202 0           push(@d, ['contact:postalInfo', @post]);
203 0 0         push(@d, Net::DRI::Protocol::EPP::Util::build_tel('contact:voice', $contact->voice()))
204             if (defined($contact->voice()));
205 0 0         push(@d, Net::DRI::Protocol::EPP::Util::build_tel('contact:fax', $contact->fax()))
206             if (defined($contact->fax()));
207 0 0         push(@d, ['contact:email', $contact->email()])
208             if (defined($contact->email()));
209 0           push(@d, build_authinfo($contact));
210 0           push(@d, build_disclose($contact));
211              
212 0           return @d;
213             }
214              
215             sub create
216             {
217 0     0 0   my ($epp, $contact) = @_;
218 0           my $mes = $epp->message();
219 0           my @d = build_command($mes, 'create', $contact);
220              
221 0 0         Net::DRI::Exception->die(1, 'protocol/EPP', 10, 'Invalid contact ' .
222             $contact) unless Net::DRI::Util::isa_contact($contact);
223 0           $contact->validate(); ## will trigger an Exception if needed
224 0           push(@d, build_cdata($contact, $epp->{contacti18n}));
225 0           $mes->command_body(\@d);
226 0           return;
227             }
228              
229             sub update
230             {
231 0     0 0   my ($epp, $contact, $todo) = @_;
232 0           my $mes = $epp->message();
233              
234 0 0         Net::DRI::Exception::usererr_invalid_parameters($todo .
235             ' must be a Net::DRI::Data::Changes object')
236             unless Net::DRI::Util::isa_changes($todo);
237 0 0 0       if ((grep { ! /^(?:add|del)$/ } $todo->types('status')) ||
  0            
238 0           (grep { ! /^(?:set)$/ } $todo->types('info')))
239             {
240 0           Net::DRI::Exception->die(0, 'protocol/EPP', 11,
241             'Only status add/del or info set available for ' .
242             'contact');
243             }
244              
245 0           my @d = build_command($mes, 'update', $contact);
246              
247 0           my $sadd = $todo->add('status');
248 0           my $sdel = $todo->del('status');
249 0 0         push(@d, ['contact:add', $sadd->build_xml('contact:status')])
250             if ($sadd);
251 0 0         push(@d, ['contact:rem', $sdel->build_xml('contact:status')])
252             if ($sdel);
253              
254 0           my $newc = $todo->set('info');
255 0 0         if ($newc)
256             {
257 0 0         Net::DRI::Exception->die(1, 'protocol/EPP', 10,
258             'Invalid contact ' . $newc)
259             unless Net::DRI::Util::isa_contact($newc);
260 0           $newc->validate(1); ## will trigger an Exception if needed
261 0           my @c = build_cdata($newc, $epp->{contacti18n});
262 0 0         push(@d, ['contact:chg', @c]) if (@c);
263             }
264              
265 0           $mes->command_body(\@d);
266 0           return;
267             }
268              
269             ####################################################################################################
270             1;