File Coverage

blib/lib/WWW/LogicBoxes/Role/Command/Domain/Transfer.pm
Criterion Covered Total %
statement 24 72 33.3
branch 0 22 0.0
condition n/a
subroutine 8 21 38.1
pod 5 5 100.0
total 37 120 30.8


line stmt bran cond sub pod time code
1             package WWW::LogicBoxes::Role::Command::Domain::Transfer;
2              
3 39     39   516378 use strict;
  39         130  
  39         1509  
4 39     39   257 use warnings;
  39         104  
  39         1395  
5              
6 39     39   845 use Moose::Role;
  39         206678  
  39         416  
7 39     39   237833 use MooseX::Params::Validate;
  39         101721  
  39         451  
8              
9 39     39   22464 use WWW::LogicBoxes::Types qw( DomainName DomainTransfer Int Str );
  39         115  
  39         486  
10              
11 39     39   468049 use WWW::LogicBoxes::DomainRequest::Transfer;
  39         190  
  39         1879  
12              
13 39     39   427 use Try::Tiny;
  39         102  
  39         3291  
14 39     39   293 use Carp;
  39         100  
  39         37711  
15              
16             requires 'submit', 'get_domain_by_id';
17              
18             our $VERSION = '1.11.0'; # VERSION
19             # ABSTRACT: Domain Transfer API Calls
20              
21             sub is_domain_transferable {
22 0     0 1   my $self = shift;
23 0           my ( $domain_name ) = pos_validated_list( \@_, { isa => DomainName } );
24              
25             return try {
26 0     0     my $response = $self->submit({
27             method => 'domains__validate_transfer',
28             params => {
29             'domain-name' => $domain_name
30             }
31             });
32              
33 0           return ( $response->{result} eq 'true' );
34             }
35             catch {
36 0 0   0     if( $_ =~ m/is currently available for Registration/ ) {
37 0           return;
38             }
39              
40 0           croak $_;
41 0           };
42             }
43              
44             sub transfer_domain {
45 0     0 1   my $self = shift;
46 0           my ( %args ) = validated_hash(
47             \@_,
48             request => { isa => DomainTransfer, coerce => 1 },
49             );
50              
51             my $response = $self->submit({
52             method => 'domains__transfer',
53             params => $args{request}->construct_request,
54 0           });
55              
56 0 0         if( $response->{status} eq 'Failed' ) {
57 0 0         if( $response->{actionstatusdesc} =~ m/Order Locked In Processing/ ) {
58 0           croak 'Domain is locked';
59             }
60             else {
61 0           croak $response->{actionstatusdesc};
62             }
63             }
64              
65 0           return $self->get_domain_by_id( $response->{entityid} );
66             }
67              
68             sub delete_domain_transfer_by_id {
69 0     0 1   my $self = shift;
70 0           my ( $domain_id ) = pos_validated_list( \@_, { isa => Int } );
71              
72             return try {
73 0     0     my $response = $self->submit({
74             method => 'domains__cancel_transfer',
75             params => {
76             'order-id' => $domain_id,
77             }
78             });
79              
80 0 0         if( lc $response->{result} eq 'success' ) {
81 0           return;
82             }
83              
84 0           croak $response;
85             }
86             catch {
87 0 0   0     if( $_ =~ m/You are not allowed to perform this action/ ) {
    0          
88 0           croak 'No matching order found';
89             }
90             elsif( $_ =~ m|Invalid action status/action type for this operation| ) {
91 0           croak 'Unable to delete';
92             }
93              
94 0           croak $_;
95 0           };
96             }
97              
98             sub resend_transfer_approval_mail_by_id {
99 0     0 1   my $self = shift;
100 0           my ( $domain_id ) = pos_validated_list( \@_, { isa => Int } );
101              
102             return try {
103 0     0     my $response = $self->submit({
104             method => 'domains__resend_rfa',
105             params => {
106             'order-id' => $domain_id,
107             }
108             });
109              
110 0 0         if( lc $response->{result} eq 'true' ) {
111 0           return;
112             }
113              
114 0           croak $response;
115             }
116             catch {
117             ## no critic ( RegularExpressions::ProhibitComplexRegexes )
118 0 0   0     if( $_ =~ m/You are not allowed to perform this action/ ) {
    0          
119 0           croak 'No matching pending transfer order found';
120             }
121             elsif( $_ =~ m/The current status of Transfer action for the domain name does not allow this operation/ ) {
122 0           croak 'Domain is not pending admin approval';
123             }
124             ## use critic
125              
126 0           croak $_;
127 0           };
128             }
129              
130             sub submit_auth_code {
131 0     0 1   my $self = shift;
132 0           my ( %args ) = validated_hash(
133             \@_,
134             id => { isa => Int },
135             auth_code => { isa => Str }, # aka EPP key
136             );
137              
138             return try {
139             my $response = $self->submit({
140             method => 'domains__transfer__submit_auth_code',
141             params => {
142             'order-id' => $args{id},
143             'auth-code' => $args{auth_code},
144             }
145 0     0     });
146              
147 0 0         if ( lc $response->{result} eq 'success' ) {
148 0           return;
149             }
150              
151 0           croak $response;
152             }
153             catch {
154 0 0   0     if ( $_ =~ m/You are not allowed to perform this action/ ) {
155 0           croak 'No matching order found';
156             }
157              
158 0           croak $_;
159 0           };
160             }
161              
162             1;
163              
164             __END__
165             =pod
166              
167             =head1 NAME
168              
169             WWW::LogicBoxes::Role::Command::Domain::Transfer - Domain Transfer Related Operations
170              
171             =head1 SYNOPSIS
172              
173             use WWW::LogicBoxes;
174             use WWW::LogicBoxes::DomainTransfer;
175             use WWW::LogicBoxes::DomainRequest::Transfer;
176              
177             my $logic_boxes = WWW::LogicBoxes->new( ... );
178              
179             # Check Transferability
180             if( $logic_boxes->is_domain_transferable( 'some-domain.com' ) ) {
181             print "Domain is transferable';
182             }
183             else {
184             print "Domain is not transferable";
185             }
186              
187             # Transfer Domain
188             my $transfer_request = WWW::LogicBoxes::DomainRequest::Transfer->new( ... );
189             my $domain_transfer = $logic_boxes->transfer_domain( $transfer_request );
190              
191             # Deletion
192             $logic_boxes->delete_domain_transfer_by_id( $domain_transfer->id );
193              
194             # Resend Transfer Approval Mail
195             $logic_boxes->resend_transfer_approval_mail_by_id( $domain_transfer->id );
196              
197             =head1 REQUIRES
198              
199             =over 4
200              
201             =item submit
202              
203             =item get_domain_by_id
204              
205             =back
206              
207             =head1 DESCRIPTION
208              
209             Implemented domain transfer related operations with the L<LogicBoxes'|http://www.logicobxes.com> API.
210              
211             =head1 METHODS
212              
213             =head2 is_domain_transferable
214              
215             use WWW::LogicBoxes;
216              
217             my $logic_boxes = WWW::LogicBoxes->new( ... );
218              
219             if( $logic_boxes->is_domain_transferable( 'some-domain.com' ) ) {
220             print "Domain is transferable';
221             }
222             else {
223             print "Domain is not transferable";
224             }
225              
226             Given a domain name, uses L<LogicBoxes|http://www.logicboxes.com> to determine if this domain is transferable in it's current state.
227              
228             B<NOTE> L<LogicBoxes|http://www.logicboxes.com> will accept transfer requests even if the domain is not actually eligble for transfer so you should call this method before making a domain transfer request.
229              
230             =head2 transfer_domain
231              
232             use WWW::LogicBoxes;
233             use WWW::LogicBoxes::DomainTransfer;
234             use WWW::LogicBoxes::DomainRequest::Transfer;
235              
236             my $logic_boxes = WWW::LogicBoxes->new( ... );
237              
238             my $transfer_request = WWW::LogicBoxes::DomainRequest::Transfer->new( ... );
239             my $domain_transfer = $logic_boxes->transfer_domain( $transfer_request );
240              
241             Given a L<WWW::LogicBoxes::DomainRequest::Transfer> or a HashRef that can be coerced into a L<WWW::LogicBoxes::DomainRequest::Transfer>, attempt to transfer the domain with L<LogicBoxes|http://www.logicboxes.com>.
242              
243             Returns a fully formed L<WWW::LogicBoxes::DomainTransfer>.
244              
245             =head2 delete_domain_transfer_by_id
246              
247             use WWW::LogicBoxes;
248             use WWW::LogicBoxes::DomainTransfer;
249             use WWW::LogicBoxes::DomainRequest::Transfer;
250              
251             my $logic_boxes = WWW::LogicBoxes->new( ... );
252              
253             my $domain_transfer = $logic_boxes->get_domain_by_id( ... );
254             $logic_boxes->delete_domain_transfer_by_id( $domain_transfer->id );
255              
256             Given an Integer representing an in progress L<transfer|WWW::LogicBoxes::DomainTransfer>, deletes the specfied domain transfer. There is a limited amount of time in which you can do this for a new transfer, and you can only do it before the transfer is completed. If you do this too often then L<LogicBoxes|http://www.logicboxes.com> will get grumpy with you.
257              
258             =head2 resend_transfer_approval_mail_by_id
259              
260             use WWW::LogicBoxes;
261             use WWW::LogicBoxes::DomainTransfer;
262             use WWW::LogicBoxes::DomainRequest::Transfer;
263              
264             my $logic_boxes = WWW::LogicBoxes->new( ... );
265              
266             my $domain_transfer = $logic_boxes->get_domain_by_id( ... );
267             $logic_boxes->resend_transfer_approval_mail_by_id( $domain_transfer->id );
268              
269             Given an Integer representing an in progress L<transfer|WWW::LogicBoxes::DomainTransfer> that has not yet been approved by the L<admin contact|WWW::LogicBoxes::Contact> as specified by the losing registrar, will resend the transfer approval email. If this method is used on a completed transfer, a registration, or a domain that has already been approved this method will croak with an error.
270              
271             =head2 submit_auth_code
272              
273             use WWW::LogicBoxes;
274             use WWW::LogicBoxes::DomainTransfer;
275              
276             my $logic_boxes = WWW::LogicBoxes->new( ... );
277             my $epp_value = somehow_get_code_from_current_registrar( ... );
278              
279             my $domain_transfer = $logic_boxes->get_domain_by_id( ... );
280             $logic_boxes->submit_auth_code( { id => $domain_transfer->id, auth_code => $epp_value } );
281              
282             Submits the Domain Secret (also known as Authorization Code, also known as EPP key) for an in-progress domain transfer. Successfull submission results in silent return, otherwise, croaks.
283              
284             =cut