File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/COOP/Contact.pm
Criterion Covered Total %
statement 12 79 15.1
branch 0 40 0.0
condition 0 15 0.0
subroutine 4 13 30.7
pod 0 9 0.0
total 16 156 10.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .COOP Contact EPP extension commands
2             ## (based on document: EPP Extensions for the .coop TLD Registrant Verification version 1.6)
3             ##
4             ## Copyright (c) 2006,2008,2013-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::Protocol::EPP::Extensions::COOP::Contact;
17              
18 1     1   905 use strict;
  1         1  
  1         23  
19 1     1   3 use warnings;
  1         1  
  1         18  
20              
21 1     1   3 use Net::DRI::Exception;
  1         2  
  1         13  
22 1     1   2 use Net::DRI::Util;
  1         1  
  1         652  
23              
24             =pod
25              
26             =head1 NAME
27              
28             Net::DRI::Protocol::EPP::Extensions::COOP::Contact - .COOP EPP Contact extension commands 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             Enetdri@dotandco.comE
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
45              
46             =head1 AUTHOR
47              
48             Patrick Mevzek, Enetdri@dotandco.comE
49              
50             =head1 COPYRIGHT
51              
52             Copyright (c) 2006,2008,2013-2014 Patrick Mevzek .
53             All rights reserved.
54              
55             This program is free software; you can redistribute it and/or modify
56             it under the terms of the GNU General Public License as published by
57             the Free Software Foundation; either version 2 of the License, or
58             (at your option) any later version.
59              
60             See the LICENSE file that comes with this distribution for more details.
61              
62             =cut
63              
64             ####################################################################################################
65              
66             sub register_commands
67             {
68 0     0 0   my ($class,$version)=@_;
69 0           my %tmp1=(
70             create => [ \&create, undef ],
71             update => [ \&update, undef ],
72             info => [ undef, \&info_parse ],
73             );
74 0           my %tmp2=(
75             create => [ \&domain_create, \&domain_parse ],
76             update => [ undef, \&domain_parse ],
77             );
78              
79 0           return { 'contact' => \%tmp1, 'domain' => \%tmp2 };
80             }
81              
82             ####################################################################################################
83              
84             sub build_command_extension
85             {
86 0     0 0   my ($mes,$epp,$tag)=@_;
87 0           return $mes->command_extension_register($tag,sprintf('xmlns:coop="%s"',($mes->nsattrs('coop'))[0]));
88             }
89              
90             sub build_sponsors
91             {
92 0     0 0   my $s=shift;
93 0 0         return map { ['coop:sponsor',$_] } (ref($s)? @$s : $s);
  0            
94             }
95              
96             sub build_prefs
97             {
98 0     0 0   my $contact=shift;
99 0           my @n;
100 0 0         push @n,['coop:langPref',$contact->lang()] if $contact->lang();
101 0 0         push @n,['coop:mailingListPref',$contact->mailing_list()] if $contact->mailing_list();
102 0           return @n;
103             }
104              
105             sub create
106             {
107 0     0 0   my ($epp,$contact)=@_;
108 0           my $mes=$epp->message();
109              
110             ## validate() has been called
111 0           my @n;
112 0           push @n,build_prefs($contact);
113 0 0         push @n,build_sponsors($contact->sponsors()) if $contact->sponsors();
114              
115 0 0         return unless @n;
116              
117 0           my $eid=build_command_extension($mes,$epp,'coop:create');
118 0           $mes->command_extension($eid,\@n);
119 0           return;
120             }
121              
122             sub update
123             {
124 0     0 0   my ($epp,$domain,$todo)=@_;
125 0           my $mes=$epp->message();
126              
127 0           my @n;
128 0 0         push @n,['coop:add',build_sponsors($todo->add('sponsor'))] if $todo->add('sponsor');
129 0 0         push @n,['coop:rem',build_sponsors($todo->del('sponsor'))] if $todo->del('sponsor');
130 0           my @nn=build_prefs($todo->set('info'));
131 0 0         push @n,['coop:chg',\@nn] if @nn;
132 0 0         return unless @n;
133              
134 0           my $eid=build_command_extension($mes,$epp,'coop:update');
135 0           $mes->command_extension($eid,\@n);
136 0           return;
137             }
138              
139             sub info_parse
140             {
141 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
142 0           my $mes=$po->message();
143 0 0         return unless $mes->is_success();
144              
145 0           my $infdata=$mes->get_extension('coop','infData');
146 0 0         return unless $infdata;
147              
148 0           my $s=$rinfo->{contact}->{$oname}->{self};
149              
150 0           my $ns=$mes->ns('coop');
151 0           my $el=$infdata->getChildrenByTagNameNS($ns,'state');
152 0 0         $s->state($el->get_node(1)->getAttribute('code')) if defined($el->get_node(1));
153              
154 0           my @s=map { $_->getFirstChild()->getData() } $infdata->getChildrenByTagNameNS($ns,'sponsor');
  0            
155 0 0         $s->sponsors(\@s) if @s;
156              
157 0           $el=$infdata->getChildrenByTagNameNS($ns,'langPref');
158 0 0         $s->lang($el->get_node(1)->getFirstChild()->getData()) if defined($el->get_node(1));
159 0           $el=$infdata->getChildrenByTagNameNS($ns,'mailingListPref');
160 0 0         $s->mailing_list($el->get_node(1)->getFirstChild()->getData()) if defined($el->get_node(1));
161 0           return;
162             }
163              
164             ####################################################################################################
165              
166             sub domain_create
167             {
168 0     0 0   my ($epp,$domain,$rd)=@_;
169              
170 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('registrant is mandatory') unless (Net::DRI::Util::has_contact($rd) && $rd->{contact}->get('registrant'));
171 0 0         Net::DRI::Exception::usererr_insufficient_parameters('registrant org is mandatory') unless $rd->{contact}->get('registrant')->org();
172 0           return;
173             }
174              
175             sub domain_parse
176             {
177 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
178 0           my $mes=$po->message();
179 0 0         return unless $mes->is_success();
180              
181 0           my $data=$mes->get_extension('coop','stateChange');
182 0 0         return unless $data;
183              
184 0           my $id=$data->getChildrenByTagNameNS($mes->ns('coop'),'id')->get_node(1)->getFirstChild()->getData();
185 0           $rinfo->{contact}->{$id}->{state}=$data->getChildrenByTagNameNS($mes->ns('coop'),'state')->get_node(1)->getAttribute('code');
186 0           $rinfo->{contact}->{$id}->{action}='verification_review';
187              
188 0 0 0       if (defined($otype) && ($otype eq 'domain') && defined($oaction) && ($oaction eq 'create' || $oaction eq 'update'))
      0        
      0        
      0        
189             {
190 0           $rinfo->{domain}->{$oname}->{registrant_id}=$id;
191 0           $rinfo->{domain}->{$oname}->{registrant_state}=$rinfo->{contact}->{$id}->{state};
192             }
193 0           return;
194             }
195              
196             ####################################################################################################
197             1;