File Coverage

blib/lib/Net/DRI/Protocol/OpenSRS/XCP/Domain.pm
Criterion Covered Total %
statement 12 330 3.6
branch 0 180 0.0
condition 0 50 0.0
subroutine 4 34 11.7
pod 0 30 0.0
total 16 624 2.5


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, OpenSRS XCP Domain commands
2             ##
3             ## Copyright (c) 2008-2011 Patrick Mevzek . All rights reserved.
4             ## (c) 2012-2013 Dmitry Belyavsky . 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::OpenSRS::XCP::Domain;
17              
18 1     1   828 use strict;
  1         2  
  1         27  
19 1     1   3 use warnings;
  1         2  
  1         20  
20              
21 1     1   4 use Net::DRI::Exception;
  1         1  
  1         16  
22 1     1   3 use Net::DRI::Util;
  1         3  
  1         3490  
23              
24             =pod
25              
26             =head1 NAME
27              
28             Net::DRI::Protocol::OpenSRS::XCP::Domain - OpenSRS XCP Domain commands 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             Patrick Mevzek, Enetdri@dotandco.comE
49              
50             =head1 COPYRIGHT
51              
52             Copyright (c) 2008-2011 Patrick Mevzek .
53             (c) 2012-2013 Dmitry Belyavsky .
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             {
69 0     0 0   my ($class,$version)=@_;
70 0           my %tmp=(
71             info => [\&info, \&info_parse ],
72             check => [\&check, \&check_parse ],
73             create => [ \&create, \&create_parse ], ## TODO : parsing of return messages
74             delete => [ \&delete, \&delete_parse ],
75             renew => [ \&renew, \&renew_parse ],
76             transfer_request => [ \&transfer_request, \&transfer_request_parse ],
77             transfer_query => [ \&transfer_query, \&transfer_query_parse ],
78             transfer_cancel => [ \&transfer_cancel, \&transfer_cancel_parse ],
79             is_mine => [\&is_mine, \&is_mine_parse ],
80             update => [\&update, undef],
81             send_authcode => [ \&send_authcode ],
82             );
83              
84 0           return { 'domain' => \%tmp };
85             }
86              
87             sub build_msg_cookie
88             {
89 0     0 0   my ($msg,$action,$cookie,$regip)=@_;
90 0           my %r=(action=>$action,object=>'domain',cookie=>$cookie);
91 0 0         $r{registrant_ip}=$regip if defined($regip);
92 0           $msg->command(\%r);
93 0           return;
94             }
95              
96             sub info
97             {
98 0     0 0   my ($xcp,$domain,$rd)=@_;
99 0           my $msg=$xcp->message();
100 0 0         Net::DRI::Exception::usererr_insufficient_parameters('A cookie is needed for domain_info') unless Net::DRI::Util::has_key($rd,'cookie');
101 0           build_msg_cookie($msg,'get',$rd->{cookie},$rd->{registrant_ip});
102 0 0         my $info_type=exists $rd->{type} ? $rd->{type} : 'all_info';
103 0           $msg->command_attributes({type => $info_type});
104 0           return;
105             }
106              
107             sub info_parse
108             {
109 0     0 0   my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
110 0           my $mes=$xcp->message();
111 0 0         return unless $mes->is_success();
112              
113 0           $rinfo->{domain}->{$oname}->{action}='info';
114 0           $rinfo->{domain}->{$oname}->{exist}=1;
115 0           my $ra=$mes->response_attributes(); ## Not parsed: dns_errors, descr
116              
117 0           my %d=(registry_createdate => 'crDate', registry_expiredate => 'exDate', registry_updatedate => 'upDate', registry_transferdate => 'trDate', expiredate => 'exDateLocal');
118 0           while (my ($k,$v)=each(%d))
119             {
120 0 0         next unless exists($ra->{$k});
121 0           $ra->{$k}=~s/\s+/T/; ## with a little effort we become ISO8601
122 0           $rinfo->{domain}->{$oname}->{$v}=$xcp->parse_iso8601($ra->{$k});
123             }
124              
125 0           my $ns=$ra->{nameserver_list};
126 0 0 0       if (defined($ns) && ref($ns) && @$ns)
      0        
127             {
128 0           my $nso=$xcp->create_local_object('hosts');
129 0           foreach my $h (@$ns)
130             {
131 0           $nso->add($h->{name},[$h->{ipaddress}]);
132             }
133 0           $rinfo->{domain}->{$oname}->{ns}=$nso;
134             }
135              
136 0           foreach my $bool (qw/sponsoring_rsp auto_renew let_expire/)
137             {
138 0 0         next unless exists($ra->{$bool});
139 0           $rinfo->{domain}->{$oname}->{$bool}=$ra->{$bool};
140             }
141              
142 0           my $c=$ra->{contact_set};
143 0 0 0       if (defined($c) && ref($c) && keys(%$c))
      0        
144             {
145 0           my $cs=$xcp->create_local_object('contactset');
146 0           while (my ($type,$v)=each(%$c))
147             {
148 0           my $c=parse_contact($xcp,$v);
149 0 0         $cs->add($c,$type eq 'owner'? 'registrant' : $type);
150             }
151 0           $rinfo->{domain}->{$oname}->{contact}=$cs;
152             }
153              
154             # Status data is available for the separate request
155 0           foreach my $opensrs_status (qw/parkp_status lock_state can_modify domain_supports transfer_away_in_progress auctionescrow/)
156             {
157 0 0         next unless exists $ra->{$opensrs_status};
158 0           $rinfo->{domain}->{$oname}->{$opensrs_status}=$ra->{$opensrs_status};
159             }
160 0           return;
161             }
162              
163             sub parse_contact
164             {
165 0     0 0   my ($xcp,$rh)=@_;
166 0           my $c=$xcp->create_local_object('contact');
167             ## No ID given back ! Waouh that is great... not !
168 0           $c->firstname($rh->{first_name});
169 0           $c->name($rh->{last_name});
170 0 0         $c->org($rh->{org_name}) if exists($rh->{org_name});
171 0 0         $c->street([map { $rh->{'address'.$_} } grep {exists($rh->{'address'.$_}) && defined($rh->{'address'.$_}) } (1,2,3)]);
  0            
  0            
172 0 0         $c->city($rh->{city}) if exists($rh->{city});
173 0 0         $c->sp($rh->{state}) if exists($rh->{state});
174 0 0         $c->pc($rh->{postal_code}) if exists($rh->{postal_code});
175 0 0         $c->cc($rh->{country}) if exists($rh->{country});
176 0 0         $c->voice($rh->{phone}) if exists($rh->{voice});
177 0 0         $c->fax($rh->{fax}) if exists($rh->{fax});
178 0 0         $c->email($rh->{email}) if exists($rh->{email});
179 0 0         $c->url($rh->{url}) if exists($rh->{url});
180 0           return $c;
181             }
182              
183             sub check
184             {
185 0     0 0   my ($xcp,$domain,$rd)=@_;
186 0           my $msg=$xcp->message();
187 0           my %r=(action=>'lookup',object=>'domain');
188 0 0         $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
189 0           $msg->command(\%r);
190 0           $msg->command_attributes({domain => $domain});
191 0           return;
192             }
193              
194             sub check_parse
195             {
196 0     0 0   my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
197 0           my $mes=$xcp->message();
198 0 0         return unless $mes->is_success();
199              
200 0           $rinfo->{domain}->{$oname}->{action}='check';
201 0           my $ra=$mes->response_attributes();
202 0 0 0       $rinfo->{domain}->{$oname}->{exist}=(exists $ra->{status} && defined($ra->{status}) && $ra->{status} eq 'available' && $mes->response_code()==210)? 0 : 1;
203 0           $rinfo->{domain}->{$oname}->{exist_reason}=$mes->response_text();
204 0           return;
205             }
206              
207             sub create
208             {
209 0     0 0   my ($xcp,$domain,$rd)=@_;
210              
211 0           sw_register($xcp, $domain, $rd, 'new'); # TBD: premium, sunrise, whois_privacy
212 0           return;
213             }
214              
215             sub create_parse
216             {
217 0     0 0   my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
218 0           my $mes=$xcp->message();
219 0 0         return unless $mes->is_success();
220              
221 0           $rinfo->{domain}->{$oname}->{action}='create';
222 0           my $ra=$mes->response_attributes();
223 0           foreach (qw/admin_email cancelled_orders error id queue_request_id forced_pending whois_privacy/) {
224 0 0         $rinfo->{domain}->{$oname}->{$_} = $ra->{$_} if exists $ra->{$_};
225             }
226 0           return;
227             }
228              
229             sub sw_register
230             {
231 0     0 0   my ($xcp,$domain,$rd,$reg_type)=@_;
232              
233 0           my $msg=$xcp->message();
234              
235 0           my %r=(action => 'sw_register', object => 'domain');
236 0 0         $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
237              
238 0           $msg->command(\%r);
239              
240 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Username+Password are required for sw_register') if grep { ! Net::DRI::Util::has_key($rd,$_) } qw/username password/;
  0            
241              
242 0 0         Net::DRI::Exception::usererr_insufficient_parameters('contacts are mandatory') unless Net::DRI::Util::has_contact($rd);
243 0           my $cs=$rd->{contact};
244 0           foreach my $t (qw/registrant admin billing/)
245             {
246 0           my @t=$cs->get($t);
247 0 0         Net::DRI::Exception::usererr_invalid_parameters('one ' . $t . ' contact is mandatory') unless @t==1;
248 0           my $co=$cs->get($t);
249 0 0         Net::DRI::Exception::usererr_insufficient_parameters($t . 'contact is mandatory') unless Net::DRI::Util::isa_contact($co);
250 0           $co->validate();
251             }
252              
253 0           my %contact_set = ();
254 0           my $attr = {reg_type => $reg_type, domain => $domain, contact_set => \%contact_set};
255 0           $contact_set{owner} = add_owner_contact($msg,$cs);
256 0           $contact_set{admin} = add_admin_contact($msg,$cs);
257 0           $contact_set{billing} = add_billing_contact($msg,$cs);
258 0 0         if ($cs->get('tech')) {
259 0           $contact_set{tech} = add_tech_contact($msg,$cs); ## optional
260 0           $attr->{custom_tech_contact} = 1;
261             } else {
262 0           $attr->{custom_tech_contact} = 0; # Use default tech contact
263             }
264              
265             # These are all the OpenSRS names for optional parameters. Might need to map generic names to OpenSRS namespace later.
266 0           foreach (qw/auto_renew affiliate_id f_lock_domain f_parkp f_whois_privacy/) {
267 0 0         $attr->{$_} = ($rd->{$_} ? 1 : 0 ) if Net::DRI::Util::has_key($rd, $_);
    0          
268             }
269 0           foreach (qw/affiliate_id reg_domain encoding_type tld_data/) {
270 0 0         $attr->{$_} = ($rd->{$_}) if Net::DRI::Util::has_key($rd, $_);
271             }
272              
273 0 0 0       if (Net::DRI::Util::has_key($rd, 'f_bypass_confirm') && Net::DRI::Util::has_auth($rd)) {
274 0           $attr->{'f_bypass_confirm'} = 1;
275 0           $attr->{'auth_info'} = $rd->{'auth'}->{'pw'};
276             }
277              
278             # TBD: ccTLD-specific flags including domain encoding.
279             # TBD: handle, link_domains, etc.
280              
281 0 0         if ($reg_type eq 'new') {
282 0 0         Net::DRI::Exception::usererr_insufficient_parameters('duration is mandatory') unless Net::DRI::Util::has_duration($rd);
283 0           $attr->{period} = $rd->{duration}->years();
284             }
285              
286 0           $attr->{reg_username} = $rd->{username};
287 0           $attr->{reg_password} = $rd->{password};
288              
289 0           $msg->command_attributes($attr);
290              
291 0           add_all_ns($domain,$msg,$rd->{ns});
292 0           return;
293             }
294              
295             sub update
296             {
297 0     0 0   my ($xcp,$domain,$todo,$rd)=@_;
298              
299 0           my $msg=$xcp->message();
300 0           my $attr = { domain => $domain };
301 0           $msg->command_attributes($attr);
302              
303 0 0         Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a non empty Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);
304 0 0         Net::DRI::Exception::usererr_insufficient_parameters('A cookie is needed for domain_info') unless Net::DRI::Util::has_key($rd,'cookie');
305              
306 0           my $nsset=$todo->set('ns');
307 0           my $contactset=$todo->set('contact');
308              
309 0 0         if (defined $nsset)
310             {
311 0 0         Net::DRI::Exception::usererr_invalid_parameters('ns changes for set must be a Net::DRI::Data::Hosts object') unless Net::DRI::Util::isa_hosts($nsset);
312 0 0         Net::DRI::Exception::usererr_invalid_parameters('change of nameservers and contacts is not supported in the same operation') if defined $contactset;
313 0 0         Net::DRI::Exception::usererr_insufficient_parameters('at least 2 nameservers are mandatory') unless ($nsset->count()>=2);
314              
315 0           build_msg_cookie($msg,'advanced_update_nameservers',$rd->{cookie},$rd->{registrant_ip});
316 0           $attr->{op_type}='assign';
317 0           $attr->{assign_ns}=[ $nsset->get_names() ];
318             }
319             else
320             {
321 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('contact changes for set must be a Net::DRI::Data::ContactSet') unless defined($contactset) && Net::DRI::Util::isa_contactset($contactset);
322              
323 0           build_msg_cookie($msg,'update_contacts',$rd->{cookie},$rd->{registrant_ip});
324 0           my %contact_set = ();
325 0           my $types = [];
326 0           foreach my $t (qw/registrant admin billing tech/)
327             {
328 0           my @t=$contactset->get($t);
329 0 0         next unless @t==1;
330 0           my $co=$t[0];
331 0 0         next unless Net::DRI::Util::isa_contact($co);
332 0           $co->validate();
333 0 0         my $registry_type = $t eq 'registrant' ? 'owner' : $t;
334 0           $contact_set{$registry_type}=add_contact_info($msg,$co);
335 0           push @$types, $registry_type;
336             }
337 0           $attr->{contact_set} = \%contact_set;
338 0           $attr->{types} = $types;
339             }
340 0           return;
341             }
342              
343             sub add_contact_info
344             {
345 0     0 0   my ($msg,$co)=@_;
346 0           my %contact = ();
347              
348 0           $contact{first_name} = $co->firstname();
349 0           $contact{last_name} = $co->name();
350              
351 0 0         $contact{org_name} = $co->org() if $co->org();
352              
353 0           my $s=$co->street();
354 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('1 line of address at least needed') unless ($s && (ref($s) eq 'ARRAY') && @$s && $s->[0]);
      0        
      0        
355              
356 0           $contact{address1} = $s->[0];
357 0 0         $contact{address2} = $s->[1] if $s->[1];
358 0 0         $contact{address3} = $s->[2] if $s->[2];
359 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('city & cc mandatory') unless ($co->city() && $co->cc());
360 0           $contact{city} = $co->city();
361             #TODO state and postal_code are required for US/CA
362 0 0         $contact{state} = $co->sp() if $co->sp();
363 0 0         $contact{postal_code} = $co->pc() if $co->pc();
364 0           $contact{country} = uc($co->cc());
365 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('voice & email mandatory') unless ($co->voice() && $co->email());
366 0           $contact{phone} = $co->voice();
367 0 0         $contact{fax} = $co->fax() if $co->fax();
368 0           $contact{email} = $co->email();
369 0 0         $contact{url} = $co->url() if $co->url();
370 0           return \%contact;
371             }
372              
373             sub add_owner_contact
374             {
375 0     0 0   my ($msg,$cs)=@_;
376 0           my $co=$cs->get('registrant');
377 0 0         return add_contact_info($msg,$co) if Net::DRI::Util::isa_contact($co);
378 0           return;
379             }
380              
381             sub add_admin_contact
382             {
383 0     0 0   my ($msg,$cs)=@_;
384 0           my $co=$cs->get('admin');
385 0 0         return add_contact_info($msg,$co) if Net::DRI::Util::isa_contact($co);
386 0           return;
387             }
388              
389             sub add_billing_contact
390             {
391 0     0 0   my ($msg,$cs)=@_;
392 0           my $co=$cs->get('billing');
393 0 0         return add_contact_info($msg,$co) if Net::DRI::Util::isa_contact($co);
394 0           return;
395             }
396              
397             sub add_tech_contact
398             {
399 0     0 0   my ($msg,$cs)=@_;
400 0           my $co=$cs->get('tech');
401 0 0         return add_contact_info($msg,$co) if Net::DRI::Util::isa_contact($co);
402 0           return;
403             }
404              
405             sub add_all_ns
406             {
407 0     0 0   my ($domain,$msg,$ns)=@_;
408 0           my @nslist = ();
409              
410 0           my $attr = $msg->command_attributes();
411 0           $attr->{custom_nameservers} = 0;
412              
413 0 0         if (defined($ns)) {
414 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('at least 2 nameservers are mandatory') unless (Net::DRI::Util::isa_hosts($ns) && $ns->count()>=2); # Name servers are optional; if present must be >=2
415              
416 0           for (my $i = 1; $i <= $ns->count(); $i++) { # Net:DRI name server list starts at 1.
417 0           my $name = $ns->get_details($i); # get_details in scalar returns name
418 0           push @nslist, { sortorder => $i, name => $name };
419             }
420 0           $attr->{custom_nameservers} = 1;
421 0           $attr->{nameserver_list} = \@nslist;
422             }
423 0           $msg->command_attributes($attr);
424 0           return;
425             }
426              
427             sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms)
428             {
429 0     0 0   my ($xcp,$domain,$rd)=@_;
430 0           my $msg=$xcp->message();
431              
432 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Reseller ID is mandatory') unless (Net::DRI::Util::has_key($rd, 'reseller_id'));
433              
434 0           my %r=(action => 'revoke', object => 'domain');
435 0 0         $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
436              
437 0           $msg->command(\%r);
438 0           my $attr = {domain => $domain, reseller => $rd->{reseller_id}};
439 0 0         $attr->{notes} = $rd->{notes} if Net::DRI::Util::has_key($rd, 'notes');
440 0           $msg->command_attributes({domain => $domain, reseller => $rd->{reseller_id}});
441 0           return;
442             }
443              
444             sub delete_parse
445             {
446 0     0 0   my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
447 0           my $mes=$xcp->message();
448 0 0         return unless $mes->is_success();
449              
450 0           $rinfo->{domain}->{$oname}->{action}='delete';
451 0           my $ra=$mes->response_attributes();
452 0           foreach (qw/charge price/) {
453 0 0         $rinfo->{domain}->{$oname}->{$_} = $ra->{$_} if exists $ra->{$_};
454             }
455 0           return;
456             }
457              
458             sub renew
459             {
460 0     0 0   my ($xcp,$domain,$rd)=@_;
461 0           my $msg=$xcp->message();
462              
463 0           my %r=(action => 'renew', object => 'domain');
464 0 0         $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
465              
466 0 0         Net::DRI::Exception::usererr_insufficient_parameters('auto_renew setting is mandatory') unless (Net::DRI::Util::has_key($rd, 'auto_renew'));
467              
468 0 0         Net::DRI::Exception::usererr_insufficient_parameters('duration is mandatory') unless Net::DRI::Util::has_duration($rd);
469 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('current expiration is mandatory') unless (Net::DRI::Util::has_key($rd, 'current_expiration') && Net::DRI::Util::check_isa($rd->{current_expiration}, 'DateTime')); # Can get this from set_cookie response.
470              
471 0           my $attr = {domain => $domain, period => $rd->{duration}->years(), currentexpirationyear => $rd->{current_expiration}->year()};
472              
473             # These are all the OpenSRS names for optional parameters. Might need to map generic names to OpenSRS namespace later.
474 0           foreach (qw/auto_renew f_parkp/) {
475 0 0         $attr->{$_} = ($rd->{$_} ? 1 : 0 ) if Net::DRI::Util::has_key($rd, $_);
    0          
476             }
477 0           foreach (qw/affiliate_id notes/) {
478 0 0         $attr->{$_} = ($rd->{$_}) if Net::DRI::Util::has_key($rd, $_);
479             }
480              
481 0   0       $rd->{handle} ||= 'process';
482 0           $attr->{handle} = $rd->{handle};
483             # TBD: handle, etc.
484              
485 0           $msg->command(\%r);
486 0           $msg->command_attributes($attr);
487 0           return;
488             }
489              
490             sub renew_parse
491             {
492 0     0 0   my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
493 0           my $mes=$xcp->message();
494 0 0         return unless $mes->is_success();
495              
496 0           $rinfo->{domain}->{$oname}->{action}='renew';
497 0           my $ra=$mes->response_attributes();
498 0           foreach (qw/auto_renew admin_email order_id id queue_request_id/) {
499 0 0         $rinfo->{domain}->{$oname}->{$_} = $ra->{$_} if exists $ra->{$_};
500             }
501 0           my ($k,$v)=('registration expiration date', 'exDate');
502 0           $ra->{$k}=~s/\s+/T/; ## with a little effort we become ISO8601
503 0 0         $rinfo->{domain}->{$oname}->{$v}=$xcp->parse_iso8601($ra->{$k}) if defined($ra->{$k});
504 0           return;
505             }
506              
507             sub transfer_request
508             {
509 0     0 0   my ($xcp,$domain,$rd)=@_;
510              
511 0           sw_register($xcp, $domain, $rd, 'transfer');
512 0           return;
513             }
514              
515             sub transfer_request_parse
516             {
517 0     0 0   my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
518 0           my $mes=$xcp->message();
519 0 0         return unless $mes->is_success();
520              
521 0           $rinfo->{domain}->{$oname}->{action}='transfer_start';
522 0           my $ra=$mes->response_attributes();
523 0           foreach (qw/admin_email cancelled_orders error id queue_request_id forced_pending whois_privacy/) {
524 0 0         $rinfo->{domain}->{$oname}->{$_} = $ra->{$_} if exists $ra->{$_};
525             }
526 0           return;
527             }
528              
529             sub transfer_query
530             {
531 0     0 0   my ($xcp,$domain,$rd)=@_;
532 0           my $msg=$xcp->message();
533              
534 0           my %r=(action => 'check_transfer', object => 'domain');
535 0 0         $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
536              
537 0           $msg->command(\%r);
538 0           $msg->command_attributes({domain => $domain, check_status => 1, get_request_address => 1}); # TBD: usable for checking transferability
539 0           return;
540             }
541              
542             sub transfer_query_parse
543             {
544 0     0 0   my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
545 0           my $mes=$xcp->message();
546 0 0         return unless $mes->is_success();
547              
548 0           $rinfo->{domain}->{$oname}->{action}='check_transfer';
549 0           my $ra=$mes->response_attributes();
550 0           foreach (qw/transferrable status request_address timestamp unixtime reason type noservice/) {
551 0 0         $rinfo->{domain}->{$oname}->{$_} = $ra->{$_} if exists $ra->{$_};
552             }
553 0           return;
554             }
555              
556             sub transfer_cancel
557             {
558 0     0 0   my ($xcp,$domain,$rd)=@_;
559 0           my $msg=$xcp->message();
560              
561 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Reseller ID is mandatory') unless (Net::DRI::Util::has_key($rd, 'reseller_id'));
562              
563 0           my %r=(action => 'cancel_transfer', object => 'transfer');
564 0 0         $r{registrant_ip}=$rd->{registrant_ip} if exists $rd->{registrant_ip};
565              
566 0           $msg->command(\%r);
567 0           $msg->command_attributes({domain => $domain, reseller => $rd->{reseller_id}}); # TBD: optional order ID
568 0           return;
569             }
570              
571             sub transfer_cancel_parse
572             {
573 0     0 0   my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
574 0           my $mes=$xcp->message();
575 0 0         return unless $mes->is_success();
576              
577 0           $rinfo->{domain}->{$oname}->{action}='cancel_transfer';
578             # This response has no attributes to capture
579 0           return;
580             }
581              
582             sub is_mine
583             {
584 0     0 0   my ($xcp,$domain,$rd)=@_;
585 0           my $msg=$xcp->message();
586              
587             # Cookie isn't used with belongs_to_rsp
588              
589 0           $msg->command ({ action => 'belongs_to_rsp' });
590 0           $msg->command_attributes ({ domain => $domain });
591 0           return;
592             }
593              
594             sub is_mine_parse
595             {
596 0     0 0   my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
597 0           my $mes=$xcp->message();
598 0 0         return unless $mes->is_success();
599              
600 0           $rinfo->{domain}->{$oname}->{action} = 'is_mine';
601 0           $rinfo->{domain}->{$oname}->{exist} = 1;
602              
603 0           my $ra=$mes->response_attributes();
604 0 0 0       return unless exists $ra->{belongs_to_rsp} && defined $ra->{belongs_to_rsp};
605              
606 0 0         $rinfo->{domain}->{$oname}->{mine}=($ra->{belongs_to_rsp})? 1 : 0;
607 0 0 0       if (exists $ra->{domain_expdate} && defined $ra->{domain_expdate}) ## only here if belongs_to_rsp=1
608             {
609 0           my $d=$ra->{domain_expdate};
610 0           $d=~s/\s+/T/; ## with a little effort we become ISO8601
611 0           $rinfo->{domain}->{$oname}->{exDate}=$xcp->parse_iso8601($d);
612             }
613 0           return;
614             }
615              
616             sub send_authcode
617             {
618 0     0 0   my ($xcp,$domain,$rd)=@_;
619 0           my $msg=$xcp->message();
620 0           my %r=(action=>'send_authcode',object=>'domain');
621 0           $msg->command(\%r);
622 0           $msg->command_attributes({domain_name => $domain});
623 0           return;
624             }
625              
626             ####################################################################################################
627             1;