File Coverage

blib/lib/Net/DRI/DRD/NAME.pm
Criterion Covered Total %
statement 27 67 40.3
branch 1 16 6.2
condition n/a
subroutine 10 21 47.6
pod 4 15 26.6
total 42 119 35.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .NAME policies
2             ##
3             ## Copyright (c) 2007-2009,2011 HEXONET Support GmbH, www.hexonet.com,
4             ## Alexander Biehl
5             ## and Patrick Mevzek .
6             ## All rights reserved.
7             ##
8             ## This file is part of Net::DRI
9             ##
10             ## Net::DRI is free software; you can redistribute it and/or modify
11             ## it under the terms of the GNU General Public License as published by
12             ## the Free Software Foundation; either version 2 of the License, or
13             ## (at your option) any later version.
14             ##
15             ## See the LICENSE file that comes with this distribution for more details.
16             ####################################################################################################
17              
18             package Net::DRI::DRD::NAME;
19              
20 2     2   1356 use strict;
  2         5  
  2         65  
21 2     2   7 use warnings;
  2         5  
  2         44  
22              
23 2     2   8 use base qw/Net::DRI::DRD/;
  2         2  
  2         686  
24              
25 2     2   16 use Net::DRI::Exception;
  2         3  
  2         35  
26 2     2   7 use Net::DRI::Util;
  2         5  
  2         31  
27 2     2   11 use DateTime::Duration;
  2         4  
  2         1177  
28              
29             =pod
30              
31             =head1 NAME
32              
33             Net::DRI::DRD::NAME - .NAME policies for Net::DRI
34              
35             =head1 DESCRIPTION
36              
37             Please see the README file for details.
38              
39             =head1 SUPPORT
40              
41             For now, support questions should be sent to:
42              
43             Enetdri@dotandco.comE
44              
45             Please also see the SUPPORT file in the distribution.
46              
47             =head1 SEE ALSO
48              
49             Ehttp://www.dotandco.com/services/software/Net-DRI/E
50              
51             =head1 AUTHOR
52              
53             Patrick Mevzek, Enetdri@dotandco.comE
54              
55             =head1 COPYRIGHT
56              
57             Copyright (c) 2007-2009,2011 HEXONET Support GmbH, Ehttp://www.hexonet.comE,
58             Alexander Biehl
59             and Patrick Mevzek .
60             All rights reserved.
61              
62             This program is free software; you can redistribute it and/or modify
63             it under the terms of the GNU General Public License as published by
64             the Free Software Foundation; either version 2 of the License, or
65             (at your option) any later version.
66              
67             See the LICENSE file that comes with this distribution for more details.
68              
69             =cut
70              
71             ####################################################################################################
72              
73             sub new
74             {
75 1     1 0 3 my $class=shift;
76 1         6 my $self=$class->SUPER::new(@_);
77 1         22 $self->{info}->{host_as_attr}=0;
78 1         2 $self->{info}->{contact_i18n}=2; ## INT only
79 1         4 return $self;
80             }
81              
82 0     0 1 0 sub periods { return map { DateTime::Duration->new(years => $_) } (1..10); }
  0         0  
83 1     1 1 2 sub name { return 'NAME'; }
84 1     1 1 3 sub tlds { return ('name'); }
85 0     0 1 0 sub object_types { return ('domain','contact','ns'); }
86 0     0 0 0 sub profile_types { return qw/epp whois/; }
87              
88             sub transport_protocol_default
89             {
90 1     1 0 2 my ($self,$type)=@_;
91              
92 1 50       4 return ('Net::DRI::Transport::Socket',{},'Net::DRI::Protocol::EPP::Extensions::NAME',{}) if $type eq 'epp';
93 0 0         return ('Net::DRI::Transport::Socket',{remote_host=>'whois.nic.name'},'Net::DRI::Protocol::Whois',{}) if $type eq 'whois';
94 0           return;
95             }
96              
97             ####################################################################################################
98              
99             sub verify_name_domain
100             {
101 0     0 0   my ($self,$ndr,$domain,$op)=@_;
102 0           return $self->_verify_name_rules($domain,$op,{check_name => 1, check_name_dots => [1,2],
103             my_tld_not_strict => 1, ## we need less strict checks because in X.Y.name domain names both X and Y are variables
104             icann_reserved => 1,
105             });
106             }
107              
108             sub emailfwd_check
109             {
110 0     0 0   my ($self,$ndr,$email)=@_;
111             ## Technical syntax check of email object needed here
112 0           my $rc=$ndr->try_restore_from_cache('emailfwd',$email,'check');
113 0 0         if (! defined $rc) { $rc=$ndr->process('emailfwd','check',[$email]); }
  0            
114 0           return $rc;
115             }
116              
117             sub emailfwd_exist ## 1/0/undef
118             {
119 0     0 0   my ($self,$ndr,$email)=@_;
120             ## Technical syntax check of email object needed here
121 0           my $rc=$ndr->emailfwd_check($email);
122 0 0         return unless $rc->is_success();
123 0           return $ndr->get_info('exist');
124             }
125              
126             sub emailfwd_info
127             {
128 0     0 0   my ($self,$ndr,$email)=@_;
129             ## Technical syntax check of email object needed here
130 0           my $rc=$ndr->try_restore_from_cache('emailfwd',$email,'info');
131 0 0         if (! defined $rc) { $rc=$ndr->process('emailfwd','info',[$email]); }
  0            
132 0           return $rc;
133             }
134              
135             sub emailfwd_create
136             {
137 0     0 0   my ($self,$ndr,$email,$rd)=@_;
138             ## Technical syntax check of email object needed here
139 0           my $rc=$ndr->process('emailfwd','create',[$email,$rd]);
140 0           return $rc;
141             }
142              
143             sub emailfwd_delete
144             {
145 0     0 0   my ($self,$ndr,$email)=@_;
146             ## Technical syntax check of email object needed here
147 0           my $rc=$ndr->process('emailfwd','delete',[$email]);
148 0           return $rc;
149             }
150              
151             sub emailfwd_update
152             {
153 0     0 0   my ($self,$ndr,$email,$tochange)=@_;
154 0           my $fp=$ndr->protocol->nameversion();
155              
156             ## Technical syntax check of email object needed here
157 0           Net::DRI::Util::check_isa($tochange,'Net::DRI::Data::Changes');
158              
159 0           foreach my $t ($tochange->types())
160             {
161 0 0         next if $ndr->protocol_capable('emailfwd_update',$t);
162 0           Net::DRI::Exception->die(0,'DRD',5,'Protocol '.$fp.' is not capable of emailfwd_update/'.$t);
163             }
164              
165 0           my $rc=$ndr->process('emailfwd','update',[$email,$tochange]);
166 0           return $rc;
167             }
168              
169             sub emailfwd_renew
170             {
171 0     0 0   my ($self,$ndr,$email,$rd)=@_;
172             ## Technical syntax check of email object needed here
173 0 0         Net::DRI::Util::check_isa($rd->{duration},'DateTime::Duration') if defined($rd->{duration});
174 0 0         Net::DRI::Util::check_isa($rd->{current_expiration},'DateTime') if defined($rd->{current_expiration});
175 0           return $ndr->process('emailfwd','renew',[$email,$rd->{duration},$rd->{current_expiration}]);
176             }
177              
178             ####################################################################################################
179             1;