File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/Nominet/Contact.pm
Criterion Covered Total %
statement 18 77 23.3
branch 0 34 0.0
condition 0 3 0.0
subroutine 6 13 46.1
pod 0 7 0.0
total 24 134 17.9


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .UK EPP Contact commands
2             ##
3             ## Copyright (c) 2008-2010,2013-2014 Patrick Mevzek . All rights reserved.
4             ## (c) 2013 Michael Holloway . 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::Nominet::Contact;
17              
18 1     1   946 use strict;
  1         2  
  1         90  
19 1     1   5 use warnings;
  1         2  
  1         27  
20              
21 1     1   3 use Net::DRI::Util;
  1         2  
  1         21  
22 1     1   4 use Net::DRI::Exception;
  1         1  
  1         16  
23 1     1   4 use Net::DRI::Protocol::EPP::Util;
  1         1  
  1         20  
24 1     1   5 use Net::DRI::Protocol::EPP::Core::Contact;
  1         2  
  1         708  
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Protocol::EPP::Extensions::Nominet::Contact - .UK EPP Contact commands for Net::DRI
31              
32             =head1 DESCRIPTION
33              
34             Please see the README file for details.
35              
36             =head1 SUPPORT
37              
38             For now, support questions should be sent to:
39              
40             Enetdri@dotandco.comE
41              
42             Please also see the SUPPORT file in the distribution.
43              
44             =head1 SEE ALSO
45              
46             Ehttp://www.dotandco.com/services/software/Net-DRI/E
47              
48             =head1 AUTHOR
49              
50             Patrick Mevzek, Enetdri@dotandco.comE
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2008-2010,2013-2014 Patrick Mevzek .
55             (c) 2013 Michael Holloway .
56             All rights reserved.
57              
58             This program is free software; you can redistribute it and/or modify
59             it under the terms of the GNU General Public License as published by
60             the Free Software Foundation; either version 2 of the License, or
61             (at your option) any later version.
62              
63             See the LICENSE file that comes with this distribution for more details.
64              
65             =cut
66              
67             ####################################################################################################
68             sub register_commands
69             {
70 0     0 0   my ($class,$version)=@_;
71 0           my %tmp=(
72             info => [ undef, \&info_parse ],
73             create => [ \&create ],
74             update => [ \&update ],
75             fork => [ \&fork, \&Net::DRI::Protocol::EPP::Core::Contact::create_parse ],
76             lock => [ \&lock ],
77             );
78              
79 0           return { 'contact' => \%tmp };
80             }
81              
82             ####################################################################################################
83             ########### Query commands
84              
85             sub info_parse
86             {
87 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
88 0           my $mes=$po->message();
89 0 0         return unless $mes->is_success();
90              
91 0           my $infdata=$mes->get_extension('contact-nom-ext','infData');
92 0 0         return unless $infdata;
93              
94 0           my $s=$rinfo->{contact}->{$oname}->{self};
95 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
96             {
97 0           my ($name,$c)=@$el;
98 0 0         $s->type($c->textContent()) if $name eq 'type';
99 0 0         $s->co_no($c->textContent()) if $name eq 'co-no';
100 0 0         $s->opt_out($c->textContent()) if $name eq 'opt-out';
101 0 0         $s->trad_name($c->textContent()) if $name eq 'trad-name';
102             }
103 0           return;
104             }
105              
106             ############ Transform commands ####################################################################
107              
108             sub contact_nom_ext
109             {
110 0     0 0   my $c=shift;
111 0           my @n;
112 0 0         push @n, ['contact-nom-ext:trad-name', $c->trad_name()] if defined $c->trad_name();
113 0 0         push @n, ['contact-nom-ext:type', $c->type()] if defined $c->type();
114 0 0         push @n, ['contact-nom-ext:co-no', $c->co_no()] if defined $c->co_no();
115 0 0         push @n, ['contact-nom-ext:opt-out', $c->opt_out()] if defined $c->opt_out();
116 0           return @n;
117             }
118              
119             sub create
120             {
121 0     0 0   my ($epp,$c)=@_;
122 0           my @n = contact_nom_ext($c);
123 0 0         return unless @n;
124 0           my $mes=$epp->message();
125 0           my $eid=$mes->command_extension_register('contact-nom-ext:create',sprintf('xmlns:contact-nom-ext="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('contact-nom-ext')));
126 0           $mes->command_extension($eid,\@n);
127 0           return;
128             }
129              
130             sub update
131             {
132             # I don't think name/org can be updated so this should be checked and return an exception. If they are the same then just remove from the changes
133 0     0 0   my ($epp,$c,$todo)=@_;
134 0           my $tochg = $todo->set('info');
135 0 0         return unless $tochg;
136 0           my @n = contact_nom_ext($tochg);
137 0 0         return unless @n;
138 0           my $mes=$epp->message();
139 0           my $eid=$mes->command_extension_register('contact-nom-ext:update',sprintf('xmlns:contact-nom-ext="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('contact-nom-ext')));
140 0           $mes->command_extension($eid,\@n);
141 0           return;
142             }
143              
144             sub fork ## no critic (Subroutines::ProhibitBuiltinHomonyms)
145             {
146 0     0 0   my ($epp,$c,$rd)=@_;
147 0           my $mes=$epp->message();
148 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Contact srID is required') unless $c->srid();
149 0 0         Net::DRI::Exception::usererr_insufficient_parameters('newContactID is required') unless $rd->{newContactId};
150 0           $mes->command(['update','f:fork',sprintf('xmlns:f="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('std-fork'))]);
151 0           my @doms = @{$rd->{domains}};
  0            
152 0           my @d=(['f:contactID',$c->srid()],['f:newContactId',$rd->{newContactId}]);
153 0           foreach (@doms) { push @d,['f:domainName',$_]; }
  0            
154 0           $mes->command_body(\@d);
155 0           return;
156             }
157              
158             sub lock ## no critic (Subroutines::ProhibitBuiltinHomonyms)
159             {
160 0     0 0   my ($epp,$c,$rd)=@_;
161 0           my $mes=$epp->message();
162 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Contact srID is required') unless $c->srid();
163 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('type must be set to investigation OR opt-out to lock a contact') unless $rd->{type} && $rd->{type} =~ m/^(investigation|opt-out)$/;
164 0           $mes->command(['update','l:lock',sprintf('xmlns:l="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('std-locks')). ' object="contact" type="'.$rd->{type}.'"']);
165 0           my @d=(['l:contactId',$c->srid()]);
166 0           $mes->command_body(\@d);
167 0           return;
168             }
169              
170             ####################################################################################################
171             1;