File Coverage

blib/lib/WWW/LogicBoxes/Role/Command/Domain.pm
Criterion Covered Total %
statement 27 141 19.1
branch 0 54 0.0
condition 0 10 0.0
subroutine 9 40 22.5
pod 10 10 100.0
total 46 255 18.0


line stmt bran cond sub pod time code
1             package WWW::LogicBoxes::Role::Command::Domain;
2              
3 38     38   514082 use strict;
  38         118  
  38         1346  
4 38     38   305 use warnings;
  38         90  
  38         1264  
5              
6 38     38   727 use Moose::Role;
  38         182328  
  38         356  
7 38     38   215530 use MooseX::Params::Validate;
  38         86940  
  38         413  
8              
9 38     38   19750 use WWW::LogicBoxes::Types qw( Bool DomainName DomainNames Int InvoiceOption PrivateNameServer Str );
  38         105  
  38         424  
10              
11 38     38   445197 use WWW::LogicBoxes::Domain::Factory;
  38         172  
  38         1523  
12              
13 38     38   304 use Try::Tiny;
  38         95  
  38         2254  
14 38     38   640 use Carp;
  38         101  
  38         1833  
15              
16 38     38   952 use Readonly;
  38         4134  
  38         81575  
17             Readonly my $DOMAIN_DETAIL_OPTIONS => [qw( All )];
18              
19             requires 'submit';
20              
21             our $VERSION = '1.10.0'; # VERSION
22             # ABSTRACT: Domain API Calls
23              
24             sub get_domain_by_id {
25 0     0 1   my $self = shift;
26 0           my ( $domain_id ) = pos_validated_list( \@_, { isa => Int } );
27              
28             return try {
29 0     0     my $response = $self->submit({
30             method => 'domains__details',
31             params => {
32             'order-id' => $domain_id,
33             'options' => $DOMAIN_DETAIL_OPTIONS,
34             }
35             });
36              
37 0           return WWW::LogicBoxes::Domain::Factory->construct_from_response( $response );
38             }
39             catch {
40 0 0   0     if( $_ =~ m/^No Entity found for Entityid/ ) {
41 0           return;
42             }
43              
44 0           croak $_;
45 0           };
46             }
47              
48             sub get_domain_by_name {
49 0     0 1   my $self = shift;
50 0           my ( $domain_name ) = pos_validated_list( \@_, { isa => DomainName } );
51              
52             return try {
53 0     0     my $response = $self->submit({
54             method => 'domains__details_by_name',
55             params => {
56             'domain-name' => $domain_name,
57             'options' => $DOMAIN_DETAIL_OPTIONS,
58             }
59             });
60              
61 0           return WWW::LogicBoxes::Domain::Factory->construct_from_response( $response );
62             }
63             catch {
64 0 0   0     if( $_ =~ m/^Website doesn't exist for/ ) {
65 0           return;
66             }
67              
68 0           croak $_;
69 0           };
70             }
71              
72             sub update_domain_contacts {
73 0     0 1   my $self = shift;
74 0           my ( %args ) = validated_hash(
75             \@_,
76             id => { isa => Int },
77             is_transfer_locked => { isa => Bool, default => 1 },
78             registrant_contact_id => { isa => Int, optional => 1 },
79             admin_contact_id => { isa => Int, optional => 1 },
80             technical_contact_id => { isa => Int, optional => 1 },
81             billing_contact_id => { isa => Int, optional => 1 },
82             );
83              
84             return try {
85 0     0     my $original_domain = $self->get_domain_by_id( $args{id} );
86              
87 0 0         if( !$original_domain ) {
88 0           croak 'No such domain exists';
89             }
90              
91 0           my $contact_mapping = {
92             registrant_contact_id => 'reg-contact-id',
93             admin_contact_id => 'admin-contact-id',
94             technical_contact_id => 'tech-contact-id',
95             billing_contact_id => 'billing-contact-id',
96             };
97              
98 0           my $num_changes = 0;
99 0           my $contacts_to_update;
100 0           for my $contact_type ( keys %{ $contact_mapping } ) {
  0            
101 0 0 0       if( $args{$contact_type} && $args{$contact_type} != $original_domain->$contact_type ) {
102 0           $contacts_to_update->{ $contact_mapping->{ $contact_type } } = $args{ $contact_type };
103 0           $num_changes++;
104             }
105             else {
106 0           $contacts_to_update->{ $contact_mapping->{ $contact_type } } = $original_domain->$contact_type;
107             }
108             }
109              
110 0 0         if( $num_changes == 0 ) {
111 0           return $original_domain;
112             }
113              
114             # The not for irtp_lock is because logicboxes treats this as opt out
115             # while I'm treating the input as just if it should lock or not
116             $self->submit({
117             method => 'domains__modify_contact',
118             params => {
119             'order-id' => $args{id},
120             'sixty-day-lock-optout' => ( !$args{is_transfer_locked} ? 'true' : 'false' ),
121 0 0         %{ $contacts_to_update }
  0            
122             }
123             });
124              
125 0           return $self->get_domain_by_id( $args{id} );
126             }
127             catch {
128             ## no critic (ControlStructures::ProhibitCascadingIfElse)
129 0 0   0     if( $_ =~ m/{registrantcontactid=registrantcontactid is invalid}/ ) {
    0          
    0          
    0          
130 0           croak 'Invalid registrant_contact_id specified';
131             }
132             elsif( $_ =~ m/{admincontactid=admincontactid is invalid}/ ) {
133 0           croak 'Invalid admin_contact_id specified';
134             }
135             elsif( $_ =~ m/{techcontactid=techcontactid is invalid}/ ) {
136 0           croak 'Invalid technical_contact_id specified';
137             }
138             elsif( $_ =~ m/{billingcontactid=billingcontactid is invalid}/ ) {
139 0           croak 'Invalid billing_contact_id specified';
140             }
141             ## use critic
142              
143 0           croak $_;
144 0           };
145             }
146              
147             sub enable_domain_lock_by_id {
148 0     0 1   my $self = shift;
149 0           my ( $domain_id ) = pos_validated_list( \@_, { isa => Int } );
150              
151             return try {
152 0     0     $self->submit({
153             method => 'domains__enable_theft_protection',
154             params => {
155             'order-id' => $domain_id,
156             }
157             });
158              
159 0           return $self->get_domain_by_id( $domain_id );
160             }
161             catch {
162 0 0   0     if( $_ =~ m/^No Entity found for Entityid/ ) {
163 0           croak 'No such domain';
164             }
165              
166 0           croak $_;
167 0           };
168             }
169              
170             sub disable_domain_lock_by_id {
171 0     0 1   my $self = shift;
172 0           my ( $domain_id ) = pos_validated_list( \@_, { isa => Int } );
173              
174             return try {
175 0     0     $self->submit({
176             method => 'domains__disable_theft_protection',
177             params => {
178             'order-id' => $domain_id,
179             }
180             });
181              
182 0           return $self->get_domain_by_id( $domain_id );
183             }
184             catch {
185 0 0   0     if( $_ =~ m/^No Entity found for Entityid/ ) {
186 0           croak 'No such domain';
187             }
188              
189 0           croak $_;
190 0           };
191             }
192              
193             sub enable_domain_privacy {
194 0     0 1   my $self = shift;
195 0           my ( %args ) = validated_hash(
196             \@_,
197             id => { isa => Int },
198             reason => { isa => Str, optional => 1 },
199             );
200              
201 0   0       $args{reason} //= 'Enabling Domain Privacy';
202              
203             return $self->_set_domain_privacy(
204             id => $args{id},
205             status => 1,
206             reason => $args{reason},
207 0           );
208             }
209              
210             sub disable_domain_privacy {
211 0     0 1   my $self = shift;
212 0           my ( %args ) = validated_hash(
213             \@_,
214             id => { isa => Int },
215             reason => { isa => Str, optional => 1 },
216             );
217              
218 0   0       $args{reason} //= 'Disabling Domain Privacy';
219              
220             return try {
221             return $self->_set_domain_privacy(
222             id => $args{id},
223             status => 0,
224             reason => $args{reason},
225 0     0     );
226             }
227             catch {
228 0 0   0     if( $_ =~ m/^Privacy Protection not Purchased/ ) {
229 0           return $self->get_domain_by_id( $args{id} );
230             }
231              
232 0           croak $_;
233 0           };
234             }
235              
236             sub _set_domain_privacy {
237 0     0     my $self = shift;
238 0           my ( %args ) = validated_hash(
239             \@_,
240             id => { isa => Int },
241             status => { isa => Bool },
242             reason => { isa => Str },
243             );
244              
245             return try {
246             $self->submit({
247             method => 'domains__modify_privacy_protection',
248             params => {
249             'order-id' => $args{id},
250             'protect-privacy' => $args{status} ? 'true' : 'false',
251             'reason' => $args{reason},
252             }
253 0 0   0     });
254              
255 0           return $self->get_domain_by_id( $args{id} );
256             }
257             catch {
258 0 0   0     if( $_ =~ m/^No Entity found for Entityid/ ) {
259 0           croak 'No such domain';
260             }
261              
262 0           croak $_;
263 0           };
264             }
265              
266             sub update_domain_nameservers {
267 0     0 1   my $self = shift;
268 0           my ( %args ) = validated_hash(
269             \@_,
270             id => { isa => Int },
271             nameservers => { isa => DomainNames },
272             );
273              
274             return try {
275             $self->submit({
276             method => 'domains__modify_ns',
277             params => {
278             'order-id' => $args{id},
279             'ns' => $args{nameservers},
280             }
281 0     0     });
282              
283 0           return $self->get_domain_by_id( $args{id} );
284             }
285             catch {
286 0 0   0     if( $_ =~ m/^No Entity found for Entityid/ ) {
    0          
    0          
287 0           croak 'No such domain';
288             }
289             elsif( $_ =~ m/is not a valid Nameserver/ ) {
290 0           croak 'Invalid nameservers provided';
291             }
292             elsif( $_ =~ m/Same value for new and old NameServers/ ) {
293 0           return $self->get_domain_by_id( $args{id} );
294             }
295              
296 0           croak $_;
297 0           };
298             }
299              
300             sub renew_domain {
301 0     0 1   my $self = shift;
302 0           my ( %args ) = validated_hash(
303             \@_,
304             id => { isa => Int },
305             years => { isa => Int },
306             is_private => { isa => Bool, optional => 1 },
307             invoice_option => { isa => InvoiceOption, default => 'NoInvoice' },
308             );
309              
310             return try {
311 0     0     my $domain = $self->get_domain_by_id( $args{id} );
312              
313 0 0         if( !$domain ) {
314 0           croak 'No such domain';
315             }
316              
317 0 0         $domain->status eq 'Deleted' and croak 'Domain is already deleted';
318              
319             $self->submit({
320             method => 'domains__renew',
321             params => {
322             'order-id' => $args{id},
323             'years' => $args{years},
324             'exp-date' => $domain->expiration_date->epoch,
325             'invoice-option' => $args{invoice_option},
326 0   0       'purchase-privacy' => $args{is_private} // $domain->is_private,
327             }
328             });
329              
330 0           return $self->get_domain_by_id( $args{id} );
331             }
332             catch {
333 0 0   0     if( $_ =~ m/^No Entity found for Entityid/ ) {
    0          
334 0           croak 'No such domain';
335             }
336             elsif( $_ =~ m/A Domain Name cannot be extended beyond/ ) {
337 0           croak 'Unable to renew, would violate max registration length';
338             }
339              
340 0           croak $_;
341 0           };
342             }
343              
344             sub resend_verification_email {
345 0     0 1   my $self = shift;
346 0           my ( %args ) = validated_hash(
347             \@_,
348             id => { isa => Int },
349             );
350              
351             return try {
352             my $response = $self->submit({
353             method => 'domains__details',
354             params => {
355             'order-id' => $args{id},
356 0     0     'options' => 'DomainStatus'
357             }
358             });
359              
360 0 0         if( $response->{raaVerificationStatus} eq 'Verified' ){
361 0           croak 'Domain already verified';
362             }
363              
364             $response = $self->submit({
365             method => 'domains__raa__resend_verification',
366             params => {
367             'order-id' => $args{id}
368             }
369 0           });
370              
371 0 0         return 1 if( $response->{result} eq 'true' );
372 0 0         return 0 if( $response->{result} eq 'false' );
373              
374 0           croak 'Resend Verification request did not return a result, unknown if sent';
375             }
376             catch {
377 0 0   0     croak 'No matching order found' if( $_ =~ m/You are not allowed to perform this action/ );
378 0 0         croak 'No such domain' if( $_ =~ m/No Entity found for Entityid/ );
379              
380 0           croak $_;
381 0           };
382             }
383              
384             1;
385              
386             __END__
387             =pod
388              
389             =head1 NAME
390              
391             WWW::LogicBoxes::Role::Command::Domain - Domain Related Operations
392              
393             =head1 SYNOPSIS
394              
395             use WWW::LogicBoxes;
396             use WWW::LogicBoxes::Contact;
397             use WWW::LogicBoxes::Domain;
398              
399             my $logic_boxes = WWW::LogicBoxes->new( ... );
400              
401             # Retrieval
402             my $domain = $logic_boxes->get_domain_by_id( 42 );
403             my $domain = $logic_boxes->get_domain_by_domain( 'test-domain.com' );
404              
405             # Update Contacts
406             my $contacts = {
407             registrant_contact => WWW::LogicBoxes::Contact->new( ... ),
408             admin_contact => WWW::LogicBoxes::Contact->new( ... ),
409             technical_contact => WWW::LogicBoxes::Contact->new( ... ),
410             billing_contact => WWW::LogicBoxes::Contact->new( ... ),
411             };
412              
413             $logic_boxes->update_domain_contacts(
414             id => $domain->id,
415             registrant_contact_id => $contacts->{registrant_contact}->id,
416             admin_contact_id => $contacts->{admin_contact}->id,
417             technical_contact_id => $contacts->{technical_contact}->id,
418             billing_contact_id => $contacts->{billing_contact}->id,
419             );
420              
421             # Domain Locking
422             $logic_boxes->enable_domain_lock_by_id( $domain->id );
423             $logic_boxes->disable_domain_lock_by_id( $domain->id );
424              
425             # Domain Privacy
426             $logic_boxes->enable_domain_privacy(
427             id => $domain->id,
428             reason => 'Enabling Domain Privacy',
429             );
430              
431             $logic_boxes->disable_domain_privacy(
432             id => $domain->id,
433             reason => 'Disabling Domain Privacy',
434             );
435              
436             # Nameservers
437             $logic_boxes->update_domain_nameservers(
438             id => $domain->id,
439             nameservers => [ 'ns1.logicboxes.com', 'ns1.logicboxes.com' ],
440             );
441              
442             # Renewals
443             $logic_boxes->renew_domain(
444             id => $domain->id,
445             years => 1,
446             is_private => 1,
447             invoice_option => 'NoInvoice',
448             );
449              
450             =head1 REQUIRES
451              
452             submit
453              
454             =head1 DESCRIPTION
455              
456             Implements domain related operations with the L<LogicBoxes's|http://www.logicboxes.com> API.
457              
458             =head2 See Also
459              
460             =over 4
461              
462             =item For Domain Registration please see L<WWW::LogicBoxes::Role::Command::Domain::Registration>
463              
464             =item For Domain Availability please see L<WWW::LogicBoxes::Role::Command::Domain::Availability>
465              
466             =item For Private Nameservers please see L<WWW::LogicBoxes::Role::Command::Domain::PrivateNameServer>
467              
468             =back
469              
470             =head1 METHODS
471              
472             =head2 get_domain_by_id
473              
474             use WWW::LogicBoxes;
475             use WWW::LogicBoxes::Domain;
476              
477             my $logic_boxes = WWW::LogicBoxes->new( ... );
478             my $domain = $logic_boxes->get_domain_by_id( 42 );
479              
480             Given a Integer L<domain|WWW::LogicBoxes::Domain> id, returns a matching L<WWW::LogicBoxes::Domain> from L<LogicBoxes|http://www.logicobxes.com>. In the event of no matching L<domain|WWW::LogicBoxes::Domain>, returns undef.
481              
482             B<NOTE> For domain transfers that are in progress a L<domain_transfer|WWW::LogicBoxes::DomainTransfer> record will be returned.
483              
484             =head2 get_domain_by_name
485              
486             use WWW::LogicBoxes;
487             use WWW::LogicBoxes::Domain;
488              
489             my $logic_boxes = WWW::LogicBoxes->new( ... );
490             my $domain = $logic_boxes->get_domain_by_domain( 'test-domain.com' );
491              
492             Given a full L<domain|WWW::LogicBoxes::Domain> name, returns a matching L<WWW::LogicBoxes::Domain> from L<LogicBoxes|http://www.logicobxes.com>. In the event of no matching L<domain|WWW::LogicBoxes::Domain>, returns undef,
493              
494             B<NOTE> For domain transfers that are in progress a L<domain_transfer|WWW::LogicBoxes::DomainTransfer> record will be returned.
495              
496             =head2 update_domain_contacts
497              
498             use WWW::LogicBoxes;
499             use WWW::LogicBoxes::Contact;
500             use WWW::LogicBoxes::Domain;
501              
502             my $logic_boxes = WWW::LogicBoxes->new( ... );
503              
504             # Update Contacts
505             my $contacts = {
506             registrant_contact => WWW::LogicBoxes::Contact->new( ... ),
507             admin_contact => WWW::LogicBoxes::Contact->new( ... ),
508             technical_contact => WWW::LogicBoxes::Contact->new( ... ),
509             billing_contact => WWW::LogicBoxes::Contact->new( ... ),
510             };
511              
512             $logic_boxes->update_domain_contacts(
513             id => $domain->id,
514             is_transfer_locked => 1, # Optional, defaults to true and only relevant for registrant changes
515             registrant_contact_id => $contacts->{registrant_contact}->id,
516             admin_contact_id => $contacts->{admin_contact}->id,
517             technical_contact_id => $contacts->{technical_contact}->id,
518             billing_contact_id => $contacts->{billing_contact}->id,
519             );
520              
521             Given a L<domain|WWW::LogicBoxes::Domain> id and optionally a L<contact|WWW::LogicBoxes::Contact> id for registrant_contact_id, admin_contact_id, technical_contact_id, and/or billing_contact_id, updates the L<domain|WWW::LogicBoxes::Domain> contacts. Also accepted is an optional is_transfer_locked that indicates if a 60 day lock should be applied to the domain after a change of registrant contact. This value defaults to true if it's not provided and is only relevant for changes of the registrant contact that trigger the IRTP process.
522              
523             This method is smart enough to not request a change if the contact hasn't been updated and consumers need only specify the elements that are changing.
524              
525             =head2 enable_domain_lock_by_id
526              
527             use WWW::LogicBoxes;
528             use WWW::LogicBoxes::Domain;
529              
530             my $logic_boxes = WWW::LogicBoxes->new( ... );
531             $logic_boxes->enable_domain_lock_by_id( $domain->id );
532              
533             Given an Integer L<domain|WWW::LogicBoxes::Domain> id, locks the L<domain|WWW::LogicBoxes::Domain> so that it can not be transfered away.
534              
535             =head2 disable_domain_lock_by_id
536              
537             use WWW::LogicBoxes;
538             use WWW::LogicBoxes::Domain;
539              
540             my $logic_boxes = WWW::LogicBoxes->new( ... );
541             $logic_boxes->disable_domain_lock_by_id( $domain->id );
542              
543             Given an Integer L<domain|WWW::LogicBoxes::Domain> id, unlocks the L<domain|WWW::LogicBoxes::Domain> so that it can be transfered away.
544              
545             =head2 enable_domain_privacy
546              
547             use WWW::LogicBoxes;
548             use WWW::LogicBoxes::Domain;
549              
550             my $logic_boxes = WWW::LogicBoxes->new( ... );
551             $logic_boxes->enable_domain_privacy(
552             id => $domain->id,
553             reason => 'Enabling Domain Privacy',
554             );
555              
556             Given an Integer L<domain|WWW::LogicBoxes::Domain> id and an optional reason ( defaults to "Enabling Domain Privacy" ), enables WHOIS Privacy Protect for the L<domain|WWW::LogicBoxes::Domain>.
557              
558             =head2 disable_domain_privacy
559              
560             use WWW::LogicBoxes;
561             use WWW::LogicBoxes::Domain;
562              
563             my $logic_boxes = WWW::LogicBoxes->new( ... );
564             $logic_boxes->disable_domain_privacy(
565             id => $domain->id,
566             reason => 'Disabling Domain Privacy',
567             );
568              
569             Given an Integer L<domain|WWW::LogicBoxes::Domain> id and an optional reason ( defaults to "Disabling Domain Privacy" ), disabled WHOIS Privacy Protect for the L<domain|WWW::LogicBoxes::Domain>.
570              
571             =head2 update_domain_nameservers
572              
573             use WWW::LogicBoxes;
574             use WWW::LogicBoxes::Domain;
575              
576             my $logic_boxes = WWW::LogicBoxes->new( ... );
577             $logic_boxes->update_domain_nameservers(
578             id => $domain->id,
579             nameservers => [ 'ns1.logicboxes.com', 'ns1.logicboxes.com' ],
580             );
581              
582             Given an Integer L<domain|WWW::LogicBoxes::Domain> id and an ArrayRef of nameserver hostnames, sets the L<domain|WWW::LogicBoxes::Domain>'s authoritative nameservers.
583              
584             =head2 renew_domain
585              
586             use WWW::LogicBoxes;
587             use WWW::LogicBooxes::Domain;
588              
589             my $logic_boxes = WWW::LogicBoxes->new( ... );
590             $logic_boxes->renew_domain(
591             id => $domain->id,
592             years => 1,
593             is_private => 1,
594             invoice_option => 'NoInvoice',
595             );
596              
597             Extends the registration term for the specified domain by the specified number of years. Note, there is a limit as to how far into the future the expiration_date can be and it's specific to each TLD, see L<http://manage.logicboxes.com/kb/servlet/KBServlet/faq1375.html> for details.
598              
599             Arguments:
600              
601             =over 4
602              
603             =item id
604              
605             The domain id to renew
606              
607             =item years
608              
609             The number of years
610              
611             =item is_private
612              
613             This is optional, if not specified then the current privacy status of the domain will be used. If there is no charge for domain privacy in your reseller panel then this field doesn't really matter. However, if there is a cost for it and you don't pass is_private => 1 then the domain privacy will be cancelled since it's term will not match the registration term.
614              
615             =item invoice_option
616              
617             See L<WWW::LogicBoxes::DomainRequest/invoice_option> for additional details about Invoicing Options. Defaults to NoInvoice.
618              
619             =back
620              
621             Returns an instance of the domain object.
622              
623             =head2 resend_verification_email
624              
625             use WWW::LogicBoxes;
626             use WWW::LogicBooxes::Domain;
627              
628             my $logic_boxes = WWW::LogicBoxes->new( ... );
629             $logic_boxes->resend_verification_email( id => $domain->id );
630              
631             Given an Integer L<domain|WWW::LogicBoxes::Domain> id, resends Verification email. Returns truthy if executed successfully or falsey if not. Will croak if unable to determine if the resend was successful.
632              
633             =cut