File Coverage

blib/lib/Net/DRI/DRD/TCI.pm
Criterion Covered Total %
statement 18 54 33.3
branch 0 14 0.0
condition 0 12 0.0
subroutine 6 16 37.5
pod 4 10 40.0
total 28 106 26.4


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .XN--P1AI (РФ)/SU/RU policies
2             ##
3             ## Copyright (c) 2010-2011 Dmitry Belyavsky
4             ## 2011,2014 Patrick Mevzek . All rights reserved.
5             ##
6             ## This file is part of Net::DRI
7             ##
8             ## Net::DRI is free software; you can redistribute it and/or modify
9             ## it under the terms of the GNU General Public License as published by
10             ## the Free Software Foundation; either version 2 of the License, or
11             ## (at your option) any later version.
12             ##
13             ## See the LICENSE file that comes with this distribution for more details.
14             ####################################################################################################
15              
16             package Net::DRI::DRD::TCI;
17              
18 1     1   601 use utf8;
  1         1  
  1         40  
19 1     1   26 use strict;
  1         2  
  1         25  
20 1     1   4 use warnings;
  1         2  
  1         20  
21              
22 1     1   3 use base qw/Net::DRI::DRD/;
  1         2  
  1         58  
23              
24 1     1   4 use Net::DRI::Util;
  1         0  
  1         14  
25 1     1   3 use DateTime::Duration;
  1         1  
  1         381  
26              
27             ####################################################################################################
28              
29             sub new
30             {
31 0     0 0   my $class=shift;
32 0           my $self=$class->SUPER::new(@_);
33 0           $self->{info}->{host_as_attr}=0;
34 0           return $self;
35             }
36              
37 0     0 1   sub periods { return map { DateTime::Duration->new(years => $_) } (1); }
  0            
38 0     0 1   sub name { return 'TCI'; }
39 0     0 1   sub tlds { return ('xn--p1ai', 'su', 'ru'); }
40 0     0 1   sub object_types { return ('domain','contact','ns'); }
41 0     0 0   sub profile_types { return qw/epp/; }
42              
43             sub transport_protocol_default
44             {
45 0     0 0   my ($self,$type)=@_;
46              
47 0 0         return ('Net::DRI::Transport::HTTP',{protocol_connection=>'Net::DRI::Protocol::EPP::Extensions::HTTP'},'Net::DRI::Protocol::EPP::Extensions::TCI',{}) if $type eq 'epp'; ## EPP is over HTTPS here
48 0           return;
49             }
50              
51             sub verify_duration_renew
52             {
53 0     0 0   my ($self,$ndr,$duration,$domain,$curexp)=@_;
54 0 0 0       ($duration,$domain,$curexp)=($ndr,$duration,$domain) unless (defined($ndr) && $ndr && (ref($ndr) eq 'Net::DRI::Registry'));
      0        
55              
56 0           my @d=$self->periods();
57 0 0 0       if (defined($duration) && @d)
58             {
59 0           my $ok=0;
60 0           foreach my $d (@d)
61             {
62 0 0         next unless (0==Net::DRI::Util::compare_durations($d,$duration));
63 0           $ok=1;
64 0           last;
65             }
66 0 0         return 1 unless $ok;
67              
68 0 0 0       if (defined $curexp && Net::DRI::Util::is_class($curexp,'DateTime'))
69             {
70 0           my $maxdelta=$d[-1]+DateTime::Duration->new(days => 61);
71 0           my $newexp=$curexp+$duration; ## New expiration
72 0           my $now=DateTime->now(time_zone => $curexp->time_zone()->name());
73 0           my $cmp=DateTime->compare($newexp,$now+$maxdelta);
74 0 0         return 2 unless ($cmp == -1); ## we must have : curexp+duration < now + maxdelta
75             }
76             }
77              
78 0           return 0; ## everything ok
79             }
80              
81             sub registrar_info
82             {
83 0     0 0   my ($self,$ndr,$reg_id)=@_;
84 0           my $rc=$ndr->process('registrar','info', [$reg_id]);
85 0           return $rc;
86             }
87              
88             sub registrar_update
89             {
90 0     0 0   my ($self,$ndr,$reg_id, $toc)=@_;
91 0           my $rc=$ndr->process('registrar','update', [$reg_id, $toc]);
92 0           return $rc;
93             }
94              
95             ####################################################################################################
96             1;
97              
98             =pod
99              
100             =head1 NAME
101              
102             Net::DRI::DRD::TCI - TCI (.SU/.RU/.XN--P1AI) Registry Driver for Net::DRI
103              
104             =head1 DESCRIPTION
105              
106             Please see the README file for details.
107              
108             =head1 SUPPORT
109              
110             For now, support questions should be sent to:
111              
112             Enetdri@dotandco.comE
113              
114             Please also see the SUPPORT file in the distribution.
115              
116             =head1 SEE ALSO
117              
118             Ehttp://www.dotandco.com/services/software/Net-DRI/E
119              
120             =head1 AUTHOR
121              
122             Dmitry Belyavsky, Ebeldmit@gmail.comE
123             Patrick Mevzek, Enetdri@dotandco.comE
124              
125             =head1 COPYRIGHT
126              
127             Copyright (c) 2010-2011 Dmitry Belyavsky
128             Copyright (c) 2011,2014 Patrick Mevzek .
129             All rights reserved.
130              
131             This program is free software; you can redistribute it and/or modify
132             it under the terms of the GNU General Public License as published by
133             the Free Software Foundation; either version 2 of the License, or
134             (at your option) any later version.
135              
136             See the LICENSE file that comes with this distribution for more details.
137              
138             =cut