File Coverage

blib/lib/Net/DRI/DRD/DENIC.pm
Criterion Covered Total %
statement 26 61 42.6
branch 1 18 5.5
condition 0 3 0.0
subroutine 10 21 47.6
pod 4 15 26.6
total 41 118 34.7


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, DENIC policies
2             ##
3             ## Copyright (c) 2007,2008,2009 Tonnerre Lombard . All rights reserved.
4             ## (c) 2010,2011,2014 Patrick Mevzek . All rights reserved.
5             ## (c) 2012-2013 Michael Holloway . All rights reserved.
6             ##
7             ## This file is part of Net::DRI
8             ##
9             ## Net::DRI is free software; you can redistribute it and/or modify
10             ## it under the terms of the GNU General Public License as published by
11             ## the Free Software Foundation; either version 2 of the License, or
12             ## (at your option) any later version.
13             ##
14             ## See the LICENSE file that comes with this distribution for more details.
15             ####################################################################################################
16              
17             package Net::DRI::DRD::DENIC;
18              
19 2     2   1434 use utf8;
  2         3  
  2         12  
20 2     2   55 use strict;
  2         3  
  2         43  
21 2     2   34 use warnings;
  2         4  
  2         54  
22              
23 2     2   8 use base qw/Net::DRI::DRD/;
  2         4  
  2         834  
24              
25 2     2   12 use DateTime::Duration;
  2         3  
  2         34  
26 2     2   8 use Net::DRI::Util;
  2         2  
  2         1163  
27              
28             =pod
29              
30             =head1 NAME
31              
32             Net::DRI::DRD::DENIC - DENIC (.DE) policies for Net::DRI
33              
34             =head1 DESCRIPTION
35              
36             Please see the README file for details.
37              
38             =head1 SUPPORT
39              
40             For now, support questions should be sent to:
41              
42             Etonnerre.lombard@sygroup.chE
43              
44             Please also see the SUPPORT file in the distribution.
45              
46             =head1 SEE ALSO
47              
48             Ehttp://www.dotandco.com/services/software/Net-DRI/E
49              
50             =head1 AUTHOR
51              
52             Tonnerre Lombard, Etonnerre.lombard@sygroup.chE
53              
54             =head1 COPYRIGHT
55              
56             Copyright (c) 2007,2008,2009 Tonnerre Lombard .
57             (c) 2010,2011,2014 Patrick Mevzek .
58             (c) 2012 Michael Holloway .
59             All rights reserved.
60              
61             This program is free software; you can redistribute it and/or modify
62             it under the terms of the GNU General Public License as published by
63             the Free Software Foundation; either version 2 of the License, or
64             (at your option) any later version.
65              
66             See the LICENSE file that comes with this distribution for more details.
67              
68             =cut
69              
70             ####################################################################################################
71              
72             sub new
73             {
74 1     1 0 2 my $class=shift;
75 1         6 my $self=$class->SUPER::new(@_);
76 1         8 $self->{info}->{host_as_attr}=1;
77 1         3 return $self;
78             }
79              
80 0     0 1 0 sub periods { return map { DateTime::Duration->new(years => $_) } (1..10); }
  0         0  
81 1     1 1 2 sub name { return 'DENIC'; }
82 1     1 1 3 sub tlds { return ('de','9.4.e164.arpa'); } ## *.9.4.e164.arpa could be queried over IRIS DCHK in the past, do not know about RRI support
83 0     0 1 0 sub object_types { return ('domain','contact'); }
84 0     0 0 0 sub profile_types { return qw/rri/; }
85              
86             sub transport_protocol_default
87             {
88 1     1 0 4 my ($self,$type)=@_;
89              
90 1 50       7 return ('Net::DRI::Transport::Socket',{remote_host=>'rri.test.denic.de',remote_port=>51131,defer=>1,close_after=>1,socktype=>'tcp'},'Net::DRI::Protocol::RRI',{version=>'2.0'}) if $type eq 'rri';
91 0           return;
92             }
93              
94             ####################################################################################################
95              
96             sub verify_name_domain
97             {
98 0     0 0   my ($self,$ndr,$domain,$op)=@_;
99 0           return $self->_verify_name_rules($domain,$op,{check_name => 1,
100             my_tld => 1,
101             icann_reserved => 1, ## is that right ??
102             });
103             }
104              
105             sub contact_update
106             {
107 0     0 0   my ($self, $reg, $c, $changes, $rd) = @_;
108 0           my $oc = $reg->get_info('self', 'contact', $c->srid());
109              
110 0 0         if (!defined($oc))
111             {
112 0           my $res = $reg->process('contact', 'info',
113             [$reg->local_object('contact')->srid($c->srid())]);
114 0 0         $oc = $reg->get_info('self', 'contact', $c->srid())
115             if ($res->is_success());
116             }
117              
118 0 0         $c->type($oc->type()) if (defined($oc));
119              
120 0           return $self->SUPER::contact_update($reg, $c, $changes, $rd);
121             }
122              
123             sub domain_update
124             {
125 0     0 0   my ($self, $reg, $dom, $changes, $rd) = @_;
126 0           $rd=Net::DRI::Util::create_params('domain_update',$rd);
127 0           my $cs = $reg->get_info('contact', 'domain', $dom);
128 0           my $ns = $reg->get_info('ns', 'domain', $dom);
129              
130 0 0 0       if (!defined($cs) || !defined($ns))
131             {
132 0           my $res = $reg->process('domain', 'info', [$dom]);
133 0 0         $cs = $reg->get_info('contact', 'domain', $dom) if ($res->is_success());
134 0 0         $ns = $reg->get_info('ns', 'domain', $dom) if ($res->is_success());
135             }
136              
137 0 0         $rd->{contact} = $cs unless (defined($rd->{contact}));
138 0 0         $rd->{ns} = $ns unless (defined($rd->{ns}));
139              
140 0           return $self->SUPER::domain_update($reg, $dom, $changes, $rd);
141             }
142              
143             sub domain_trade
144             {
145 0     0 0   my ($self, $reg, $dom, $rd) = @_;
146 0           return $reg->process('domain', 'trade', [$dom, $rd]);
147             }
148              
149             sub domain_transit
150             {
151 0     0 0   my ($self, $reg, $dom, $rd) = @_;
152 0           return $reg->process('domain', 'transit', [$dom, $rd]);
153             }
154              
155             sub domain_migrate_descr
156             {
157 0     0 0   my ($self, $reg, $dom, $rd) = @_;
158 0           return $reg->process('domain', 'migrate_descr', [$dom, $rd]);
159             }
160              
161             sub domain_create_authinfo
162             {
163 0     0 0   my ($self, $reg, $dom, $rd) = @_;
164 0           return $reg->process('domain', 'create_authinfo', [$dom, $rd]);
165             }
166              
167             sub domain_delete_authinfo
168             {
169 0     0 0   my ($self, $reg, $dom, $rd) = @_;
170 0           return $reg->process('domain', 'delete_authinfo', [$dom, $rd]);
171             }
172              
173             ####################################################################################################
174             1;