File Coverage

blib/lib/IO/EPP/CoCCA.pm
Criterion Covered Total %
statement 12 48 25.0
branch 0 12 0.0
condition 0 17 0.0
subroutine 4 9 44.4
pod 5 5 100.0
total 21 91 23.0


line stmt bran cond sub pod time code
1             package IO::EPP::CoCCA;
2              
3             =encoding utf8
4              
5             =head1 NAME
6              
7             IO::EPP::CoCCA
8              
9             =head1 SYNOPSIS
10              
11             use IO::EPP::CoCCA;
12              
13             # Parameters for IO::Socket::SSL
14             my %sock_params = (
15             PeerHost => 'registry.rusnames.net',
16             PeerPort => 700,
17             # without certificate
18             Timeout => 30,
19             );
20              
21             # Create object, get greeting and call login()
22             my $conn = IO::EPP::CoCCA->new( {
23             user => 'login',
24             pass => 'xxxx',
25             sock_params => \%sock_params,
26             test_mode => 0, # real connect
27             } );
28              
29             # Check domain
30             my ( $answ, $code, $msg ) = $conn->check_domains( { domains => [ 'xn--d1acufc.xn--p1acf' ] } );
31              
32             # Call logout() and destroy object
33             undef $conn;
34              
35             =head1 DESCRIPTION
36              
37             Module for work with .РУС/.xn--p1acf, .CX, ... tlds. All list see on https://cocca.org.nz/#five
38              
39             Frontends:
40             https://rusnames.com/
41             https://cocca.org.nz/
42              
43             Backend:
44             https://secure.coccaregistry.net/
45              
46             CoCCA features:
47              
48             - not show authinfo in domain:info
49              
50             =cut
51              
52 1     1   1803 use IO::EPP::Base;
  1         3  
  1         53  
53 1     1   17 use parent qw( IO::EPP::Base );
  1         3  
  1         9  
54              
55 1     1   61 use strict;
  1         2  
  1         18  
56 1     1   4 use warnings;
  1         1  
  1         409  
57              
58              
59             my $rgp_ext = 'xmlns:rgp="urn:ietf:params:xml:ns:rgp-1.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:ietf:params:xml:ns:rgp-1.0 rgp-1.0.xsd"';
60              
61              
62             sub make_request {
63 0     0 1   my ( $action, $params ) = @_;
64              
65 0           my ( $self, $code, $msg, $answ );
66              
67 0 0         unless ( $params->{conn} ) {
68 0   0       $params->{sock_params}{PeerHost} ||= 'registry.rusnames.net'; # .РУС / .xn--p1acf
69 0   0       $params->{sock_params}{PeerPort} ||= 700;
70              
71 0           ( $self, $code, $msg ) = __PACKAGE__->new( $params );
72              
73 0 0 0       unless ( $code and $code == 1000 ) {
74 0           goto END_MR;
75             }
76             }
77             else {
78 0           $self = $params->{conn};
79             }
80              
81              
82 0           $self->{critical_error} = '';
83              
84 0 0         if ( $self->can( $action ) ) {
85 0           ( $answ, $code, $msg ) = $self->$action( $params );
86             }
87             else {
88 0           $msg = "undefined command <$action>, request cancelled";
89 0           $code = 0;
90             }
91              
92              
93             END_MR:
94              
95 0 0         $msg .= '; ' . $self->{critical_error} if $self->{critical_error};
96              
97 0           my $full_answ = "code: $code\nmsg: $msg";
98              
99 0 0 0       $answ = {} unless $answ && ref $answ;
100              
101 0           $answ->{code} = $code;
102 0           $answ->{msg} = $msg;
103              
104 0 0         return wantarray ? ( $answ, $full_answ, $self ) : $answ;
105             }
106              
107             =head1 METHODS
108              
109             Next, those functions are redefined in which the provider has additions to the EPP
110              
111             =head2 login
112              
113             Ext params for login,
114              
115             INPUT: new password for change
116              
117             =cut
118              
119             sub login {
120 0     0 1   my ( $self, $pw ) = @_;
121              
122 0           my $svcs = '
123             urn:ietf:params:xml:ns:contact-1.0
124             urn:ietf:params:xml:ns:domain-1.0
125             urn:ietf:params:xml:ns:host-1.0';
126 0           my $extension = '
127             urn:ietf:params:xml:ns:rgp-1.0
128             https://production.coccaregistry.net/cocca-ip-verification-1.1
129             https://production.coccaregistry.net/cocca-contact-proxy-1.0
130             https://production.coccaregistry.net/cocca-contact-proxy-create-update-1.0
131             https://production.coccaregistry.net/cocca-reseller-1.0
132             urn:ietf:params:xml:ns:secDNS-1.1
133             urn:ietf:params:xml:ns:fee-0.8';
134              
135 0           return $self->SUPER::login( $pw, $svcs, $extension );
136             }
137              
138              
139              
140             sub create_domain {
141 0     0 1   my ( $self, $params ) = @_;
142              
143 0   0       $params->{authinfo} ||= IO::EPP::Base::gen_pw();
144              
145             $params->{extension} =
146             '
147             RUB
148 0           '.$params->{price}.'
149             ';
150              
151 0           return $self->SUPER::create_domain( $params );
152             }
153              
154             =head2 restore_domain
155              
156             Domain redemption
157              
158             INPUT:
159             params key C -- name of the domain to be redeemed
160              
161             OUTPUT:
162             see L.
163              
164             =cut
165              
166             sub restore_domain {
167 0     0 1   my ( $self, $params ) = @_;
168              
169             $params->{extension} =
170 0           "
171            
172             ";
173              
174 0           return $self->SUPER::update_domain( $params );
175             }
176              
177              
178             =head2 confirmations_restore_domain
179              
180             Confirmation of domain redemption
181              
182             INPUT:
183             C -- whois before delete, can set 'none';
184             C -- whois on now, can set 'none';
185             C -- date-time of domain deletion in UTC;
186             C -- date-time of sending the redemption request in UTC.
187              
188             Fields already filled in:
189             C -- the reason for the redemption;
190             C -- write that this is all for the client, not for us;
191             C -- can be without additions.
192              
193             =cut
194              
195             sub confirmations_restore_domain {
196 0     0 1   my ( $self, $params ) = @_;
197              
198 0   0       $params->{pre_data} ||= 'none';
199 0   0       $params->{post_data} ||= 'none';
200              
201 0           $params->{extension} = <
202            
203            
204            
205             $$params{pre_data}
206             $$params{post_data}
207             $$params{del_time}
208             $$params{rest_time}
209             Customer forgot to renew.
210             I agree that the Domain Name has not been restored in order to assume the rights to use or sell the name to myself or for any third party.
211             I agree that the information provided in this Restore Report is true to the best of my knowledge, and acknowledge that intentionally supplying false information in the Restore Report shall constitute an incurable material breach of the Registry-Registrar Agreement.
212            
213            
214            
215            
216             RGPEXT
217              
218 0           return $self->SUPER::update_domain( $params );
219             }
220              
221              
222             1;
223              
224             __END__