File Coverage

blib/lib/WWW/LogicBoxes/Role/Command/Domain/Transfer.pm
Criterion Covered Total %
statement 24 62 38.7
branch 0 18 0.0
condition n/a
subroutine 8 18 44.4
pod 4 4 100.0
total 36 102 35.2


line stmt bran cond sub pod time code
1             package WWW::LogicBoxes::Role::Command::Domain::Transfer;
2              
3 38     38   476221 use strict;
  38         114  
  38         1313  
4 38     38   216 use warnings;
  38         93  
  38         1248  
5              
6 38     38   696 use Moose::Role;
  38         188336  
  38         335  
7 38     38   217506 use MooseX::Params::Validate;
  38         91202  
  38         367  
8              
9 38     38   19531 use WWW::LogicBoxes::Types qw( DomainName DomainTransfer Int );
  38         116  
  38         421  
10              
11 38     38   407133 use WWW::LogicBoxes::DomainRequest::Transfer;
  38         172  
  38         1700  
12              
13 38     38   396 use Try::Tiny;
  38         94  
  38         2868  
14 38     38   250 use Carp;
  38         92  
  38         27139  
15              
16             requires 'submit', 'get_domain_by_id';
17              
18             our $VERSION = '1.10.1'; # 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             1;
131              
132             __END__
133             =pod
134              
135             =head1 NAME
136              
137             WWW::LogicBoxes::Role::Command::Domain::Transfer - Domain Transfer Related Operations
138              
139             =head1 SYNOPSIS
140              
141             use WWW::LogicBoxes;
142             use WWW::LogicBoxes::DomainTransfer;
143             use WWW::LogicBoxes::DomainRequest::Transfer;
144              
145             my $logic_boxes = WWW::LogicBoxes->new( ... );
146              
147             # Check Transferability
148             if( $logic_boxes->is_domain_transferable( 'some-domain.com' ) ) {
149             print "Domain is transferable';
150             }
151             else {
152             print "Domain is not transferable";
153             }
154              
155             # Transfer Domain
156             my $transfer_request = WWW::LogicBoxes::DomainRequest::Transfer->new( ... );
157             my $domain_transfer = $logic_boxes->transfer_domain( $transfer_request );
158              
159             # Deletion
160             $logic_boxes->delete_domain_transfer_by_id( $domain_transfer->id );
161              
162             # Resend Transfer Approval Mail
163             $logic_boxes->resend_transfer_approval_mail_by_id( $domain_transfer->id );
164              
165             =head1 REQUIRES
166              
167             =over 4
168              
169             =item submit
170              
171             =item get_domain_by_id
172              
173             =back
174              
175             =head1 DESCRIPTION
176              
177             Implemented domain transfer related operations with the L<LogicBoxes'|http://www.logicobxes.com> API.
178              
179             =head1 METHODS
180              
181             =head2 is_domain_transferable
182              
183             use WWW::LogicBoxes;
184              
185             my $logic_boxes = WWW::LogicBoxes->new( ... );
186              
187             if( $logic_boxes->is_domain_transferable( 'some-domain.com' ) ) {
188             print "Domain is transferable';
189             }
190             else {
191             print "Domain is not transferable";
192             }
193              
194             Given a domain name, uses L<LogicBoxes|http://www.logicboxes.com> to determine if this domain is transferable in it's current state.
195              
196             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.
197              
198             =head2 transfer_domain
199              
200             use WWW::LogicBoxes;
201             use WWW::LogicBoxes::DomainTransfer;
202             use WWW::LogicBoxes::DomainRequest::Transfer;
203              
204             my $logic_boxes = WWW::LogicBoxes->new( ... );
205              
206             my $transfer_request = WWW::LogicBoxes::DomainRequest::Transfer->new( ... );
207             my $domain_transfer = $logic_boxes->transfer_domain( $transfer_request );
208              
209             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>.
210              
211             Returns a fully formed L<WWW::LogicBoxes::DomainTransfer>.
212              
213             =head2 delete_domain_transfer_by_id
214              
215             use WWW::LogicBoxes;
216             use WWW::LogicBoxes::DomainTransfer;
217             use WWW::LogicBoxes::DomainRequest::Transfer;
218              
219             my $logic_boxes = WWW::LogicBoxes->new( ... );
220              
221             my $domain_transfer = $logic_boxes->get_domain_by_id( ... );
222             $logic_boxes->delete_domain_transfer_by_id( $domain_transfer->id );
223              
224             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.
225              
226             =head2 resend_transfer_approval_mail_by_id
227              
228             use WWW::LogicBoxes;
229             use WWW::LogicBoxes::DomainTransfer;
230             use WWW::LogicBoxes::DomainRequest::Transfer;
231              
232             my $logic_boxes = WWW::LogicBoxes->new( ... );
233              
234             my $domain_transfer = $logic_boxes->get_domain_by_id( ... );
235             $logic_boxes->resend_transfer_approval_mail_by_id( $domain_transfer->id );
236              
237             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.
238              
239             =cut