File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/PRO/Domain.pm
Criterion Covered Total %
statement 9 60 15.0
branch 0 46 0.0
condition 0 30 0.0
subroutine 3 6 50.0
pod 0 3 0.0
total 12 145 8.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .PRO domain extensions
2             ##
3             ## Copyright (c) 2008 Tonnerre Lombard .
4             ## (c) 2010,2013 Patrick Mevzek .
5             ## 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::Protocol::EPP::Extensions::PRO::Domain;
18              
19 1     1   773 use strict;
  1         3  
  1         58  
20 1     1   8 use warnings;
  1         2  
  1         33  
21              
22 1     1   5 use Net::DRI::Util;
  1         2  
  1         623  
23              
24             =pod
25              
26             =head1 NAME
27              
28             Net::DRI::Protocol::EPP::Extensions::PRO::Domain - .PRO EPP domain extensions for Net::DRI
29              
30             =head1 DESCRIPTION
31              
32             Please see the README file for details.
33              
34             =head1 SUPPORT
35              
36             For now, support questions should be sent to:
37              
38             Edevelopment@sygroup.chE
39              
40             Please also see the SUPPORT file in the distribution.
41              
42             =head1 SEE ALSO
43              
44             Ehttp://www.dotandco.com/services/software/Net-DRI/E and
45             Ehttp://oss.bdsprojects.net/projects/netdri/E
46              
47             =head1 AUTHOR
48              
49             Tonnerre Lombard Etonnerre.lombard@sygroup.chE,
50             Alexander Biehl, Einfo@hexonet.netE, HEXONET Support GmbH,
51             Ehttp://www.hexonet.net/E.
52              
53             =head1 COPYRIGHT
54              
55             Copyright (c) 2008 Tonnerre Lombard .
56             (c) 2010,2013 Patrick Mevzek .
57             All rights reserved.
58              
59             This program is free software; you can redistribute it and/or modify
60             it under the terms of the GNU General Public License as published by
61             the Free Software Foundation; either version 2 of the License, or
62             (at your option) any later version.
63              
64             See the LICENSE file that comes with this distribution for more details.
65              
66             =cut
67              
68             ####################################################################################################
69              
70             sub register_commands
71             {
72 0     0 0   my ($class,$version)=@_;
73 0           my %tmp=(
74             create => [ \&add_pro_extinfo ],
75             update => [ \&add_pro_extinfo ],
76             info => [ undef, \&parse ]
77             );
78              
79 0           return { 'domain' => \%tmp };
80             }
81              
82             ####################################################################################################
83             ############ Transform commands
84              
85             sub add_pro_extinfo
86             {
87 0     0 0   my ($epp, $domain, $rd) = @_;
88 0           my $mes = $epp->message();
89 0           my @prodata;
90             my @tmdata;
91 0           my $pw;
92              
93 0 0         $rd = +{ pro => $rd->set('pro') } if Net::DRI::Util::isa_changes($rd);
94 0 0 0       return unless (Net::DRI::Util::has_key($rd,'pro') && (ref($rd->{pro}) eq 'HASH'));
95 0           my $ph = $rd->{pro};
96              
97 0 0         push(@prodata, ['rpro:tradeMarkName', $ph->{tmname}])
98             if (exists($ph->{tmname}));
99 0 0         push(@prodata, ['rpro:tradeMarkJurisdiction', $ph->{tmjurisdiction}])
100             if (exists($ph->{tmjurisdiction}));
101 0 0 0       push(@prodata, ['rpro:tradeMarkDate', $ph->{tmdate}->strftime('%Y-%m-%dT%H:%M:%S.%1NZ')])
102             if (exists($ph->{tmdate}) && Net::DRI::Util::is_class($ph->{tmdate}, 'DateTime'));
103 0 0 0       push(@prodata, ['rpro:tradeMarkNumber', int($ph->{tmnumber})])
104             if (exists($ph->{tmnumber}) && int($ph->{tmnumber}));
105              
106 0 0 0       push(@prodata, ['rpro:registrationType', (exists($ph->{activate}) &&
    0          
107             $ph->{activate} ? +{ activate => 'y' } : +{}), $ph->{type}])
108             if (exists($ph->{type}));
109 0 0 0       push(@prodata, ['rpro:redirectTarget', $ph->{redirect}])
110             if (exists($ph->{redirect}) &&
111             Net::DRI::Util::is_hostname($ph->{redirect}));
112 0 0         push(@prodata, ['rpro:tradeMark', @tmdata]) if (@tmdata);
113              
114 0 0 0       if (Net::DRI::Util::has_auth($ph) && exists($ph->{auth}->{pw}))
115             {
116 0           $pw = $ph->{auth}->{pw};
117 0           delete($ph->{auth}->{pw});
118             }
119              
120 0 0         push(@prodata, ['rpro:authorization', $ph->{auth}, $pw])
121             if (exists($ph->{auth}));
122 0 0         return unless (@prodata);
123              
124 0           my $eid = $mes->command_extension_register('rpro:proDomain',sprintf('xmlns:rpro="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('rpro')));
125 0           $mes->command_extension($eid, [@prodata]);
126 0           return;
127             }
128              
129             sub parse
130             {
131 0     0 0   my ($po, $otype, $oaction, $oname, $rinfo) = @_;
132 0           my $mes = $po->message();
133 0           my $infdata = $mes->get_extension('rpro','proDomain');
134 0           my $pro = {};
135 0           my $c;
136              
137 0 0         return unless ($infdata);
138              
139 0           $c = $infdata->getFirstChild();
140              
141 0   0       while (defined($c) && $c)
142             {
143 0   0       my $name = $c->localname() || $c->nodeName();
144 0 0         next unless $name;
145              
146 0 0         if ($name eq 'registrationType')
    0          
    0          
147             {
148 0           $pro->{type} = $c->getFirstChild()->getData();
149             }
150             elsif ($name eq 'redirectTarget')
151             {
152 0           $pro->{redirect} = $c->getFirstChild()->getData();
153             }
154             elsif ($name eq 'tradeMark')
155             {
156 0           my $to = $c->getFirstChild();
157              
158 0   0       while (defined($to) && $to)
159             {
160 0   0       my $totag = $to->localname() || $to->nodeName();
161 0 0         next unless ($totag);
162              
163 0 0         if ($totag eq 'tradeMarkName')
    0          
    0          
    0          
164             {
165 0           $pro->{tmname} =
166             $to->getFirstChild()->getData();
167             }
168             elsif ($totag eq 'tradeMarkJurisdiction')
169             {
170 0           $pro->{tmjurisdiction} =
171             $to->getFirstChild()->getData();
172             }
173             elsif ($totag eq 'tradeMarkDate')
174             {
175 0           $pro->{tmdate} = $po->parse_iso8601(
176             $to->getFirstChild()->getData());
177             }
178             elsif ($totag eq 'tradeMarkNumber')
179             {
180 0           $pro->{tmnumber} = int($to->getFirstChild()->
181             getData());
182             }
183 0           } continue { $to=$to->getNextSibling(); }
184             }
185 0           } continue { $c=$c->getNextSibling(); }
186              
187 0           $rinfo->{$otype}->{$oname}->{pro} = $pro;
188 0           return;
189             }
190              
191             ####################################################################################################
192             1;