File Coverage

blib/lib/IO/EPP/Afilias.pm
Criterion Covered Total %
statement 12 71 16.9
branch 0 28 0.0
condition 0 21 0.0
subroutine 4 13 30.7
pod 9 9 100.0
total 25 142 17.6


line stmt bran cond sub pod time code
1             package IO::EPP::Afilias;
2              
3             =encoding utf8
4              
5             =head1 NAME
6              
7             IO::EPP::Afilias
8              
9             =head1 SYNOPSIS
10              
11             use IO::EPP::Afilias;
12              
13             # Parameters for IO::Socket::SSL
14             my %sock_params = (
15             PeerHost => 'epp.afilias.net',
16             PeerPort => 700,
17             SSL_key_file => 'key_file.pem',
18             SSL_cert_file => 'cert_file.pem',
19             Timeout => 30,
20             );
21              
22             # Create object, get greeting and call login()
23             my $conn = IO::EPP::Afilias->new( {
24             user => '12345-XX',
25             pass => 'XXXXXXXX',
26             sock_params => \%sock_params,
27             server => 'afilias', # or 'pir', ...
28             test_mode => 0, # real connect
29             } );
30              
31             # Check domain
32             my ( $answ, $code, $msg ) = $conn->check_domains( { domains => [ 'org.info' ] } );
33              
34             # Call logout() and destroy object
35             undef $conn;
36              
37             =head1 DESCRIPTION
38              
39             working with registries that have Afilias backend.
40              
41             Frontends: Afilias, PIR, DotAsia, ...
42              
43             Feature: at the initial request, you must specify the server parameter for activation the necessary extensions.
44              
45             Now it is C or C.
46              
47             =head1 AUTHORS
48              
49             Vadim Likhota
50              
51             =cut
52              
53 1     1   1737 use IO::EPP::Base;
  1         20  
  1         31  
54 1     1   6 use parent qw( IO::EPP::Base );
  1         1  
  1         7  
55              
56 1     1   51 use strict;
  1         1  
  1         16  
57 1     1   4 use warnings;
  1         7  
  1         729  
58              
59              
60             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"';
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} ||= 'epp.afilias.net';
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   0       $code //= '';
98              
99 0           my $full_answ = "code: $code\nmsg: $msg";
100              
101 0 0 0       $answ = {} unless $answ && ref $answ;
102              
103 0           $answ->{code} = $code;
104 0           $answ->{msg} = $msg;
105              
106 0 0         return wantarray ? ( $answ, $full_answ, $self ) : $answ;
107             }
108              
109             =head1 METHODS
110              
111             =head2 new
112              
113             See description in L
114              
115             Requires the C field to be specified, which can have values: C for .org/.ngo/.ong/.орг/.संगठन/.机构, C for other tlds.
116              
117             =cut
118              
119             sub new {
120 0     0 1   my ( $package, $params ) = @_;
121              
122 0 0         unless ( $params->{server} ) {
123 0 0         if ( $params->{sock_params}{PeerHost} =~ /\.afilias.net$/ ) {
    0          
124 0           $params->{server} = 'afilias';
125             }
126             elsif ( $params->{sock_params}{PeerHost} =~ /\.publicinterestregistry.net$/ ) {
127 0           $params->{server} = 'pir';
128             }
129             }
130              
131 0           return $package->SUPER::new( $params );
132             }
133              
134             =head2 login
135              
136             Ext params for login,
137              
138             INPUT: new password for change
139              
140             =cut
141              
142             sub login {
143 0     0 1   my ( $self, $pw ) = @_;
144              
145 0           my $svcs = '
146             urn:ietf:params:xml:ns:domain-1.0
147             urn:ietf:params:xml:ns:host-1.0
148             urn:ietf:params:xml:ns:contact-1.0';
149              
150 0           my $extension = '
151             urn:afilias:params:xml:ns:oxrs-1.1
152             urn:ietf:params:xml:ns:rgp-1.0
153             urn:ietf:params:xml:ns:secDNS-1.1
154             urn:ietf:params:xml:ns:launch-1.0';
155              
156              
157 0 0 0       if ( $self->{server} and $self->{server} eq 'afilias' ) {
    0 0        
158 0           $extension .= '
159             urn:afilias:params:xml:ns:idn-1.0
160             urn:afilias:params:xml:ns:ipr-1.1
161             urn:ietf:params:xml:ns:fee-0.8';
162             }
163             elsif ( $self->{server} and $self->{server} eq 'pir' ) {
164 0           $extension .= '
165             urn:afilias:params:xml:ns:idn-1.0
166             urn:afilias:params:xml:ns:trademark-1.0';
167             }
168              
169 0           return $self->SUPER::login( $pw, $svcs, $extension );
170             }
171              
172              
173             sub create_contact {
174 0     0 1   my ( $self, $params ) = @_;
175              
176 0           $params->{authinfo} = IO::EPP::Base::gen_pw( 16 );
177              
178             # contact:disclose flag not supported, need to use personal service of hiding of contacts
179              
180             # $params->{pp_ext} = '
181             #
182             #
183             #
184             # ';
185              
186 0           return $self->SUPER::create_contact( $params );
187             }
188              
189             =head2 check_domains, create_domain
190              
191             For IDN domains you need to specify the language code in the C field
192              
193             List of IDN characters for all zones see in L
194              
195             =cut
196              
197             sub check_domains {
198 0     0 1   my ( $self, $params ) = @_;
199              
200 0 0         if ( $params->{lang} ) {
201             $params->{extension} = '
202            
203 0           ' . $params->{idn_lang} . '
204             '
205             }
206              
207 0           return $self->SUPER::check_domains( $params );
208             }
209              
210              
211             sub create_domain {
212 0     0 1   my ( $self, $params ) = @_;
213              
214 0   0       $params->{authinfo} ||= IO::EPP::Base::gen_pw( 16 );
215              
216 0           my $extension = '';
217              
218 0 0         if ( $params->{lang} ) {
219             $extension = '
220            
221 0           ' . $params->{idn_lang} . '
222             '
223             }
224              
225 0           return $self->SUPER::create_domain( $params );
226             }
227              
228              
229             sub transfer {
230 0     0 1   my ( $self, $params ) = @_;
231              
232 0 0         if ( $params->{authinfo} ) {
233 0           $params->{authinfo} =~ s/&/&/g;
234 0           $params->{authinfo} =~ s/
235 0           $params->{authinfo} =~ s/>/>/g;
236             }
237              
238 0           return $self->SUPER::transfer( $params );
239             }
240              
241              
242             =head2 restore_domain
243              
244             first call for restore_domain
245              
246             =cut
247              
248             sub restore_domain {
249 0     0 1   my ( $self, $params ) = @_;
250              
251 0           $params->{extension} = "
252            
253            
254             ";
255              
256 0           return $self->SUPER::update_domain( $params );
257             }
258              
259             =head2 confirmations_restore_domain
260              
261             second call for restore_domain
262              
263             C -- whois before delete
264             C -- whois on now
265             C -- delete domain date-time, see. upd_date in domain:info before call restore_domain
266             C -- date-time of sending the redemption request in UTC.
267             C -- restore reason, variants:
268             C, C, C.
269              
270             The following parameters have already been defined:
271              
272             C -- write that this is all for the client, not for us,
273             since the phrase is standard, you only need to substitute the company and the position of the one who buys the domain: C, C
274             C -- can and without other.
275              
276             Instead, you need to pass:
277              
278             C -- name of your organization and its ID in the registry;
279             C -- name, surname and position of the employee who is responsible for the purchase of remote domains.
280              
281             =cut
282              
283             sub confirmations_restore_domain {
284 0     0 1   my ( $self, $params ) = @_;
285              
286 0           $params->{extension} = <
287            
288            
289            
290             $$params{pre_data}
291             $$params{post_data}
292             $$params{del_time}
293             $$params{rest_time}
294             $$params{reason}
295             $$params{company}, attests that we have not restored the name above in order to assume the rights to use or sell the Registered Name ourselves or for any third party
296             $$params{company}, attests that the information in this report is true to the best of our knowledge,
297             and we acknowledge that intentionally suplying false informationin the Restore Report shall constitute an incurable material breach of the Registry-Registrar Agreement
298             I, $$params{position}, attest that I am duly authorized to submit Restore Reports on behalf of $$params{company}
299            
300            
301            
302            
303             RGPEXT
304              
305 0           return $self->SUPER::update_domain( $params );
306             }
307              
308              
309             1;
310              
311             __END__