File Coverage

blib/lib/Net/DRI/DRD/LU.pm
Criterion Covered Total %
statement 21 65 32.3
branch 1 22 4.5
condition 0 9 0.0
subroutine 8 22 36.3
pod 4 17 23.5
total 34 135 25.1


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .LU policy from DocRegistrar-2.0.6.pdf
2             ##
3             ## Copyright (c) 2007-2011,2013 Patrick Mevzek . All rights reserved.
4             ##
5             ## This file is part of Net::DRI
6             ##
7             ## Net::DRI is free software; you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation; either version 2 of the License, or
10             ## (at your option) any later version.
11             ##
12             ## See the LICENSE file that comes with this distribution for more details.
13             ####################################################################################################
14              
15             package Net::DRI::DRD::LU;
16              
17 2     2   1364 use strict;
  2         2  
  2         53  
18 2     2   6 use warnings;
  2         3  
  2         44  
19              
20 2     2   6 use base qw/Net::DRI::DRD/;
  2         3  
  2         693  
21              
22 2     2   1015 use Net::DRI::Data::Contact::LU;
  2         5  
  2         15  
23              
24             __PACKAGE__->make_exception_for_unavailable_operations(qw/domain_renew domain_transfer_accept domain_transfer_refuse contact_transfer contact_transfer_start contact_transfer_stop contact_transfer_query contact_transfer_accept contact_transfer_refuse/);
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::DRD::LU - .LU policies for Net::DRI
31              
32             =head1 DESCRIPTION
33              
34             Please see the README file for details.
35              
36             =head1 SUPPORT
37              
38             For now, support questions should be sent to:
39              
40             Enetdri@dotandco.comE
41              
42             Please also see the SUPPORT file in the distribution.
43              
44             =head1 SEE ALSO
45              
46             Ehttp://www.dotandco.com/services/software/Net-DRI/E
47              
48             =head1 AUTHOR
49              
50             Patrick Mevzek, Enetdri@dotandco.comE
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2007-2011,2013 Patrick Mevzek .
55             All rights reserved.
56              
57             This program is free software; you can redistribute it and/or modify
58             it under the terms of the GNU General Public License as published by
59             the Free Software Foundation; either version 2 of the License, or
60             (at your option) any later version.
61              
62             See the LICENSE file that comes with this distribution for more details.
63              
64             =cut
65              
66             ####################################################################################################
67              
68             sub new
69             {
70 1     1 0 2 my $class=shift;
71 1         7 my $self=$class->SUPER::new(@_);
72 1         6 $self->{info}->{host_as_attr}=0;
73 1         2 $self->{info}->{contact_i18n}=1; ## LOC only
74 1         2 return $self;
75             }
76              
77 0     0 1 0 sub periods { return; } ## registry does not expect any duration at all
78 1     1 1 2 sub name { return 'DNSLU'; }
79 1     1 1 2 sub tlds { return ('lu'); }
80 0     0 1 0 sub object_types { return ('domain','contact','ns'); }
81 0     0 0 0 sub profile_types { return qw/epp whois/; }
82              
83             sub transport_protocol_default
84             {
85 1     1 0 1 my ($self,$type)=@_;
86              
87 1 50       7 return ('Net::DRI::Transport::Socket',{},'Net::DRI::Protocol::EPP::Extensions::LU',{}) if $type eq 'epp';
88 0 0         return ('Net::DRI::Transport::Socket',{remote_host=>'whois.dns.lu'},'Net::DRI::Protocol::Whois',{}) if $type eq 'whois';
89 0           return;
90             }
91              
92             sub set_factories
93             {
94 0     0 0   my ($self,$po)=@_;
95 0     0     $po->factories('contact',sub { return Net::DRI::Data::Contact::LU->new(@_); });
  0            
96 0           return;
97             }
98              
99             ####################################################################################################
100              
101             sub verify_name_domain
102             {
103 0     0 0   my ($self,$ndr,$domain,$op)=@_;
104 0           return $self->_verify_name_rules($domain,$op,{check_name => 1,
105             my_tld => 1,
106             min_length => 3,
107             no_double_hyphen => 1,
108             });
109             }
110              
111             sub domain_status_allows
112             {
113 0     0 0   my ($self,$ndr,$domain,$what,$rd)=@_;
114              
115 0 0         return 0 unless ($what=~m/^(?:delete|update|transfer|renew|trade|transfer-trade|transfer-restore)$/);
116 0           my $s=$self->domain_current_status($ndr,$domain,$rd);
117 0 0         return 0 unless (defined($s));
118              
119 0 0 0       return !$s->is_pending() && $s->can_delete() if ($what eq 'delete');
120 0 0 0       return !$s->is_pending() && $s->can_update() if ($what eq 'update'); ## no pendingCreate pendingUpdate pendingDelete
121 0 0         return $s->can_transfer() if ($what eq 'transfer');
122 0 0         return 0 if ($what eq 'renew');
123 0 0         return $s->has_not('serverTradeProhibited','pendingCreate','pendingDelete') if ($what eq 'trade');
124 0 0         return $s->has_not('serverTransferProhibited','serverTradeProhibited') if ($what eq 'transfer-trade');
125 0 0 0       return $s->has_not('serverTransferProhibited','serverRestoreProhibited') && $s->has_any('pendingDelete') if ($what eq 'transfer-restore');
126 0           return 0; ## failsafe
127             }
128              
129             sub domain_restore
130             {
131 0     0 0   my ($self,$ndr,$domain)=@_;
132 0           $self->enforce_domain_name_constraints($ndr,$domain,'restore');
133 0           return $ndr->process('domain','restore',[$domain]);
134             }
135              
136             sub domain_transfer_trade_start
137             {
138 0     0 0   my ($self,$ndr,$domain,$rd)=@_;
139 0           $self->enforce_domain_name_constraints($ndr,$domain,'transfer_trade');
140 0           return $ndr->process('domain','transfer_trade_request',[$domain,$rd]);
141             }
142              
143             sub domain_transfer_trade_query
144             {
145 0     0 0   my ($self,$ndr,$domain)=@_;
146 0           $self->enforce_domain_name_constraints($ndr,$domain,'transfer_trade');
147 0           return $ndr->process('domain','transfer_trade_query',[$domain]);
148             }
149              
150             sub domain_transfer_trade_stop
151             {
152 0     0 0   my ($self,$ndr,$domain)=@_;
153 0           $self->enforce_domain_name_constraints($ndr,$domain,'transfer_trade');
154 0           return $ndr->process('domain','transfer_trade_cancel',[$domain]);
155             }
156              
157             sub domain_transfer_restore_start
158             {
159 0     0 0   my ($self,$ndr,$domain,$rd)=@_;
160 0           $self->enforce_domain_name_constraints($ndr,$domain,'transfer_restore');
161 0           return $ndr->process('domain','transfer_restore_request',[$domain,$rd]);
162             }
163              
164             sub domain_transfer_restore_query
165             {
166 0     0 0   my ($self,$ndr,$domain)=@_;
167 0           $self->enforce_domain_name_constraints($ndr,$domain,'transfer_restore');
168 0           return $ndr->process('domain','transfer_restore_query',[$domain]);
169             }
170              
171             sub domain_transfer_restore_stop
172             {
173 0     0 0   my ($self,$ndr,$domain)=@_;
174 0           $self->enforce_domain_name_constraints($ndr,$domain,'transfer_restore');
175 0           return $ndr->process('domain','transfer_restore_cancel',[$domain]);
176             }
177              
178             ####################################################################################################
179             1;