File Coverage

blib/lib/Net/DRI/DRD/OpenSRS.pm
Criterion Covered Total %
statement 22 71 30.9
branch 1 20 5.0
condition n/a
subroutine 9 20 45.0
pod 4 15 26.6
total 36 126 28.5


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, OpenSRS Registry Driver
2             ##
3             ## Copyright (c) 2008-2014 Patrick Mevzek . All rights reserved.
4             ##
5             ## This file is part of Net::DRI
6             ##
7             ## Net::DRI is free software; you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation; either version 2 of the License, or
10             ## (at your option) any later version.
11             ##
12             ## See the LICENSE file that comes with this distribution for more details.
13             ####################################################################################################
14              
15             package Net::DRI::DRD::OpenSRS;
16              
17 2     2   1104 use strict;
  2         2  
  2         46  
18 2     2   5 use warnings;
  2         2  
  2         100  
19              
20 2     2   7 use base qw/Net::DRI::DRD/;
  2         2  
  2         604  
21              
22 2     2   11 use DateTime::Duration;
  2         2  
  2         28  
23 2     2   8 use Net::DRI::Util;
  2         2  
  2         1107  
24              
25             =pod
26              
27             =head1 NAME
28              
29             Net::DRI::DRD::OpenSRS - OpenSRS Registry driver for Net::DRI
30              
31             =head1 DESCRIPTION
32              
33             Please see the README file for details.
34              
35             =head2 CURRENT LIMITATIONS
36              
37             Only domain_info and account_list_domains are available.
38              
39             =head1 SUPPORT
40              
41             For now, support questions should be sent to:
42              
43             Enetdri@dotandco.comE
44              
45             Please also see the SUPPORT file in the distribution.
46              
47             =head1 SEE ALSO
48              
49             Ehttp://www.dotandco.com/services/software/Net-DRI/E
50              
51             =head1 AUTHOR
52              
53             Patrick Mevzek, Enetdri@dotandco.comE
54              
55             =head1 COPYRIGHT
56              
57             Copyright (c) 2008-2014 Patrick Mevzek .
58             All rights reserved.
59              
60             This program is free software; you can redistribute it and/or modify
61             it under the terms of the GNU General Public License as published by
62             the Free Software Foundation; either version 2 of the License, or
63             (at your option) any later version.
64              
65             See the LICENSE file that comes with this distribution for more details.
66              
67             =cut
68              
69             ####################################################################################################
70              
71             sub new
72             {
73 1     1 0 1 my $class=shift;
74 1         6 my $self=$class->SUPER::new(@_);
75 1         2 return $self;
76             }
77              
78 0     0 1 0 sub periods { return map { DateTime::Duration->new(years => $_) } (1..10); }
  0         0  
79 1     1 1 2 sub name { return 'OpenSRS'; }
80             ## See http://opensrs.com/site/services/domains/pricing
81 1     1 1 12 sub tlds { return (qw/com net org info biz mobi pro name asia tel/,
82             qw/co me pw tv ws xxx jobs aero coop/,
83             qw/ac ag ai ar br bz ca cc cl ec gd gs gy hn ht lc ms mx pe pm pr sr sx tc us uy vc ve vg/,
84             qw/at be ch cz de dk es eu fi fr gr gg gl hr hu im is it je li lt lu lv md nl no pl pt ro ru se si ua uk/,
85             qw/af am cn hk in io jp kg kr la mn my ph qa sg tl tm tw/,
86             qw/ae cd cm il ly ma mu re sc sh so st to yt za/,
87             qw/as au cx fm hm ki nu nz sb tf tk wf/,
88             ); }
89 0     0 1 0 sub object_types { return ('domain','ns'); }
90 0     0 0 0 sub profile_types { return qw/xcp/; }
91              
92             sub transport_protocol_default
93             {
94 1     1 0 1 my ($self,$type)=@_;
95              
96 1 50       4 return ('Net::DRI::Transport::HTTP',{},'Net::DRI::Protocol::OpenSRS::XCP',{}) if $type eq 'xcp';
97 0           return;
98             }
99              
100             ####################################################################################################
101              
102             sub domain_operation_needs_is_mine
103             {
104 0     0 0   my ($self,$ndr,$domain,$op)=@_;
105 0           return;
106             }
107              
108             sub account_list_domains
109             {
110 0     0 0   my ($self,$ndr)=@_;
111 0           my $rc=$ndr->try_restore_from_cache('account','domains','list');
112 0 0         if (! defined $rc) { $rc=$ndr->process('account','list_domains'); }
  0            
113 0           return $rc;
114             }
115              
116             sub domain_info
117             {
118 0     0 0   my ($self,$ndr,$domain,$rd)=@_;
119 0           $self->enforce_domain_name_constraints($ndr,$domain,'info');
120              
121 0           my $rc=$ndr->try_restore_from_cache('domain',$domain,'info');
122 0 0         if (! defined $rc)
123             {
124             ## First grab a cookie, if needed
125 0 0         unless (Net::DRI::Util::has_key($rd,'cookie'))
126             {
127 0           $rd=Net::DRI::Util::create_params('domain_info',$rd); ## will fail in set_cookie because other params needed, but at least this will be ok for next line ; otherwise do true checks of value needed
128 0           $rd->{domain}=$domain;
129 0           $rc=$ndr->process('session','set_cookie',[$rd]);
130 0 0         return $rc unless $rc->is_success();
131 0           $rd->{cookie}=$ndr->get_info('value','session','cookie'); ## Store cookie somewhere (taking into account date of expiry or some TTLs) ?
132             }
133             ## Now do the real info
134 0           $rc=$ndr->process('domain','info',[$domain,$rd]); ## the $domain is not really used here, as it was used during set_cookie above
135             }
136 0           return $rc;
137             }
138              
139             sub domain_update
140             {
141 0     0 0   my ($self,$ndr,$domain,$changes,$rd)=@_;
142 0           $self->enforce_domain_name_constraints($ndr,$domain,'update');
143              
144             ## First grab a cookie, if needed
145 0 0         unless (Net::DRI::Util::has_key($rd,'cookie'))
146             {
147 0           $rd=Net::DRI::Util::create_params('domain_update',$rd); ## will fail in set_cookie because other params needed, but at least this will be ok for next line ; otherwise do true checks of value needed
148 0           $rd->{domain}=$domain;
149 0           my $rc=$ndr->process('session','set_cookie',[$rd]);
150 0 0         return $rc unless $rc->is_success();
151 0           $rd->{cookie}=$ndr->get_info('value','session','cookie'); ## Store cookie somewhere (taking into account date of expiry or some TTLs) ?
152             }
153             ## Now do the real update
154 0           my $rc=$ndr->process('domain','update',[$domain,$changes,$rd]); ## the $domain is not really used here, as it was used during set_cookie above
155 0           return $rc;
156             }
157              
158             sub domain_is_mine
159             {
160 0     0 0   my ($self,$ndr,$domain,$rd)=@_;
161 0           my $clid=$self->info('client_id');
162 0 0         return unless defined $clid;
163 0           my $rc=$ndr->process('domain','is_mine',[$domain,$rd]);
164 0 0         return unless $rc->is_success();
165 0           my $mine=$ndr->get_info('mine');
166 0 0         return unless defined $mine;
167 0           return $mine;
168             }
169              
170             sub domain_send_authcode
171             {
172 0     0 0   my ($self,$ndr,$domain)=@_;
173 0           my $rc=$ndr->process('domain','send_authcode',[$domain]);
174 0           return $rc;
175             }
176              
177             sub host_registry_check
178             {
179 0     0 0   my ($self,$ndr,$hostname,$registry)=@_;
180              
181 0           return $ndr->process('nameserver', 'registry_check', [$hostname, $registry]);
182             }
183              
184             sub host_registry_add
185             {
186 0     0 0   my ($self,$ndr,$hostname,$rd)=@_;
187              
188 0           return $ndr->process('nameserver', 'registry_add', [$hostname, $rd]);
189             }
190              
191             ####################################################################################################
192             1;