File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/PL/Message.pm
Criterion Covered Total %
statement 9 81 11.1
branch 0 42 0.0
condition 0 18 0.0
subroutine 3 6 50.0
pod 0 3 0.0
total 12 150 8.0


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .PL Message EPP extension commands
2             ##
3             ## Copyright (c) 2008 Tonnerre Lombard .
4             ## Copyright (c) 2008 Thorsten Glaser for Sygroup GmbH
5             ## Copyright (c) 2010,2013 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::Protocol::EPP::Extensions::PL::Message;
19              
20 1     1   663 use strict;
  1         2  
  1         22  
21 1     1   3 use warnings;
  1         1  
  1         19  
22              
23 1     1   3 use Net::DRI::Exception;
  1         1  
  1         548  
24              
25             =pod
26              
27             =head1 NAME
28              
29             Net::DRI::Protocol::EPP::Extensions::PL::Message - .PL EPP Message extension commands for Net::DRI
30              
31             =head1 DESCRIPTION
32              
33             Please see the README file for details.
34              
35             =head1 SUPPORT
36              
37             For now, support questions should be sent to:
38              
39             Edevelopment@sygroup.chE
40              
41             Please also see the SUPPORT file in the distribution.
42              
43             =head1 SEE ALSO
44              
45             Ehttp://oss.bsdprojects.net/project/netdri/E
46              
47             =head1 AUTHOR
48              
49             Tonnerre Lombard, Etonnerre.lombard@sygroup.chE
50             Thorsten Glaser
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2008 Tonnerre Lombard .
55             Copyright (c) 2008 Thorsten Glaser for Sygroup GmbH
56             Copyright (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             plretrieve => [ \&poll, \&parse_poll ]
75             );
76              
77 0           return { 'message' => \%tmp };
78             }
79              
80             ####################################################################################################
81              
82             sub poll
83             {
84 0     0 0   my ($epp,$msgid)=@_;
85 0 0         Net::DRI::Exception::usererr_invalid_parameters('In EPP, you can not specify the message id you want to retrieve') if defined($msgid);
86 0           my $mes=$epp->message();
87 0           $mes->command([['poll',{op=>'req'}]]);
88 0           return;
89             }
90              
91             sub parse_poll
92             {
93 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
94 0           my ($epp,$rep,$ext,$ctag,@conds,@tags);
95 0           my $mes=$po->message();
96 0           my $msgid=$mes->msg_id();
97 0           my $domname;
98             my $domauth;
99 0           my $action;
100              
101 0 0         return unless $mes->is_success();
102 0 0         return if $mes->result_is('COMMAND_SUCCESSFUL_QUEUE_EMPTY');
103 0 0 0       return unless (defined($msgid) && $msgid);
104              
105 0           my $mesdata = $mes->node_resdata();
106 0 0         return unless ($mesdata);
107              
108 0           $rinfo->{message}->{session}->{last_id}=$msgid;
109              
110 0           foreach my $cnode ($mesdata->childNodes) {
111 0   0       my $cmdname = $cnode->localName || $cnode->nodeName;
112              
113 0 0         if ($cmdname eq 'pollAuthInfo') {
114 0           my $ra = $rinfo->{message}->{$msgid}->{extra_info};
115 0           push @{$ra}, $cnode->toString(); ### ???
  0            
116 0           $action = 'pollAuthInfo';
117              
118 0           foreach my $cnode ($cnode->childNodes) {
119 0   0       my $objname = $cnode->localName || $cnode->nodeName;
120              
121 0 0         if ($objname eq 'domain') {
122 0           $otype = 'domain';
123              
124 0           foreach my $cnode ($cnode->childNodes) {
125 0   0       my $infname = $cnode->localName || $cnode->nodeName;
126              
127 0 0         if ($infname eq 'name') {
    0          
128 0           $domname = $cnode->getFirstChild()->getData();
129             } elsif ($infname eq 'authInfo') {
130 0           $domauth = $cnode;
131             }
132             }
133             }
134             }
135             } else {
136             # copied from Net/DRI/Protocol/EPP/Core/Domain.pm:transfer_parse
137 0           my $trndata=$mes->get_response('domain','trnData');
138 0 0         if ($trndata) {
139 0           my $pd=DateTime::Format::ISO8601->new();
140 0           my $c=$trndata->getFirstChild();
141 0           while ($c) {
142 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
143 0   0       my $name=$c->localname() || $c->nodeName();
144 0 0         next unless $name;
145              
146 0 0         if ($name eq 'name') {
    0          
    0          
147 0           $domname = lc($c->getFirstChild()->getData());
148 0           $action = 'transfer';
149             } elsif ($name=~m/^(trStatus|reID|acID)$/) {
150 0           my $fc = $c->getFirstChild();
151 0 0         $rinfo->{domain}->{$domname}->{$1}=$fc->getData() if (defined($fc));
152             } elsif ($name=~m/^(reDate|acDate|exDate)$/) {
153 0           $rinfo->{domain}->{$domname}->{$1}=$pd->parse_datetime($c->getFirstChild()->getData());
154             }
155 0           } continue { $c=$c->getNextSibling(); }
156             }
157             }
158             }
159 0 0         if (defined ($domname)) {
160 0           $otype = 'domain';
161 0           $oname = $domname;
162 0           $rinfo->{domain}->{$domname}->{name} = $domname;
163 0           $rinfo->{domain}->{$domname}->{exist} = 1;
164 0           $rinfo->{message}->{$msgid}->{object_id} = $domname;
165 0 0         if (defined ($domauth)) {
166 0           my $c = $domauth->getFirstChild();
167              
168 0           while ($c)
169             {
170 0           my $typename;
171 0 0         next unless ($c->nodeType == 1); ## only for element nodes
172 0   0       $typename = $c->localName || $c->nodeName;
173             $rinfo->{domain}->{$domname}->{auth} = {
174 0           $typename => $c->getFirstChild()->getData()
175             };
176 0           } continue { $c = $c->getNextSibling(); }
177             }
178             }
179 0 0         if (defined ($action)) {
180 0           $rinfo->{message}->{$msgid}->{action} = $action;
181 0 0         if (defined ($domname)) {
182 0           $rinfo->{domain}->{$oname}->{action} = $action;
183             }
184             }
185 0           $rinfo->{message}->{$msgid}->{object_type} = $otype;
186 0           $rinfo->{$otype}->{$oname}->{message}=$mesdata;
187 0           return;
188             }
189              
190             ####################################################################################################
191             1;