| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | ## Domain Registry Interface, EPP NSgroup extension commands | 
| 2 |  |  |  |  |  |  | ## (based on .BE Registration_guidelines_v4_7_1) | 
| 3 |  |  |  |  |  |  | ## | 
| 4 |  |  |  |  |  |  | ## Copyright (c) 2005-2010,2013 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::NSgroup; | 
| 17 |  |  |  |  |  |  |  | 
| 18 | 1 |  |  | 1 |  | 838 | use strict; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 32 |  | 
| 19 | 1 |  |  | 1 |  | 4 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 21 |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 | 1 |  |  | 1 |  | 3 | use Net::DRI::Util; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 13 |  | 
| 22 | 1 |  |  | 1 |  | 4 | use Net::DRI::Exception; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 1052 |  | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | =pod | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | =head1 NAME | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | Net::DRI::Protocol::EPP::Extensions::NSgroup - EPP NSgroup 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) 2005-2010,2013 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=( create => [ \&create ], | 
| 70 |  |  |  |  |  |  | check  => [ \&check, \&check_parse ], | 
| 71 |  |  |  |  |  |  | info   => [ \&info, \&info_parse ], | 
| 72 |  |  |  |  |  |  | delete => [ \&delete ], | 
| 73 |  |  |  |  |  |  | update => [ \&update ], | 
| 74 |  |  |  |  |  |  | ); | 
| 75 |  |  |  |  |  |  |  | 
| 76 | 0 |  |  |  |  |  | $tmp1{check_multi}=$tmp1{check}; | 
| 77 |  |  |  |  |  |  |  | 
| 78 | 0 |  |  |  |  |  | return { 'nsgroup' => \%tmp1 }; | 
| 79 |  |  |  |  |  |  | } | 
| 80 |  |  |  |  |  |  |  | 
| 81 | 0 |  |  | 0 | 0 |  | sub capabilities_add { return ('nsgroup_update','ns',['set']); } | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | sub ns | 
| 84 |  |  |  |  |  |  | { | 
| 85 | 0 |  |  | 0 | 0 |  | my ($mes)=@_; | 
| 86 | 0 |  |  |  |  |  | my $ns=$mes->ns('nsgroup'); | 
| 87 | 0 | 0 |  |  |  |  | return defined $ns? $ns : 'http://www.dns.be/xml/epp/nsgroup-1.0'; | 
| 88 |  |  |  |  |  |  | } | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | sub build_command | 
| 91 |  |  |  |  |  |  | { | 
| 92 | 0 |  |  | 0 | 0 |  | my ($epp,$msg,$command,$hosts)=@_; | 
| 93 |  |  |  |  |  |  |  | 
| 94 | 0 |  |  |  |  |  | my @gn; | 
| 95 | 0 | 0 |  |  |  |  | foreach my $h ( grep { defined } (ref $hosts eq 'ARRAY')? @$hosts : ($hosts)) | 
|  | 0 |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | { | 
| 97 | 0 | 0 |  |  |  |  | my $gn=Net::DRI::Util::isa_nsgroup($h)? $h->name() : $h; | 
| 98 | 0 | 0 | 0 |  |  |  | Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid NSgroup name: '.$gn) unless (defined $gn && $gn && ! ref $gn && Net::DRI::Util::xml_is_normalizedstring($gn,1,100)); | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 99 | 0 |  |  |  |  |  | push @gn,$gn; | 
| 100 |  |  |  |  |  |  | } | 
| 101 |  |  |  |  |  |  |  | 
| 102 | 0 | 0 |  |  |  |  | Net::DRI::Exception->die(1,'protocol/EPP',2,'NSgroup name needed') unless @gn; | 
| 103 | 0 |  |  |  |  |  | $msg->command([$command,'nsgroup:'.$command,sprintf('xmlns:nsgroup="%s" xsi:schemaLocation="%s %s"',$msg->nsattrs('nsgroup'))]); | 
| 104 | 0 |  |  |  |  |  | return map { ['nsgroup:name',$_] } @gn; | 
|  | 0 |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | } | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | sub add_nsname | 
| 108 |  |  |  |  |  |  | { | 
| 109 | 0 |  |  | 0 | 0 |  | my ($ns)=@_; | 
| 110 | 0 | 0 |  |  |  |  | return () unless defined $ns; | 
| 111 | 0 |  |  |  |  |  | my @names; | 
| 112 | 0 | 0 |  |  |  |  | if (! ref $ns) | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | { | 
| 114 | 0 |  |  |  |  |  | @names=($ns); | 
| 115 |  |  |  |  |  |  | } elsif (ref $ns eq 'ARRAY') | 
| 116 |  |  |  |  |  |  | { | 
| 117 | 0 |  |  |  |  |  | @names=@$ns; | 
| 118 |  |  |  |  |  |  | } elsif (Net::DRI::Util::isa_nsgroup($ns)) | 
| 119 |  |  |  |  |  |  | { | 
| 120 | 0 |  |  |  |  |  | @names=$ns->get_names(); | 
| 121 |  |  |  |  |  |  | } | 
| 122 |  |  |  |  |  |  |  | 
| 123 | 0 |  |  |  |  |  | foreach my $n (@names) | 
| 124 |  |  |  |  |  |  | { | 
| 125 | 0 | 0 |  |  |  |  | next if Net::DRI::Util::is_hostname($n); | 
| 126 | 0 |  |  |  |  |  | Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid host name: '.$n); | 
| 127 |  |  |  |  |  |  | } | 
| 128 |  |  |  |  |  |  |  | 
| 129 | 0 |  |  |  |  |  | return map { ['nsgroup:ns',$_] } @names; | 
|  | 0 |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | } | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | #################################################################################################### | 
| 133 |  |  |  |  |  |  | ########### Query commands | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | sub check | 
| 136 |  |  |  |  |  |  | { | 
| 137 | 0 |  |  | 0 | 0 |  | my ($epp,@hosts)=@_; | 
| 138 | 0 |  |  |  |  |  | my $mes=$epp->message(); | 
| 139 | 0 |  |  |  |  |  | my @d=build_command($epp,$mes,'check',\@hosts); | 
| 140 | 0 |  |  |  |  |  | $mes->command_body(\@d); | 
| 141 | 0 |  |  |  |  |  | return; | 
| 142 |  |  |  |  |  |  | } | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | sub check_parse | 
| 145 |  |  |  |  |  |  | { | 
| 146 | 0 |  |  | 0 | 0 |  | my ($po,$otype,$oaction,$oname,$rinfo)=@_; | 
| 147 | 0 |  |  |  |  |  | my $mes=$po->message(); | 
| 148 | 0 | 0 |  |  |  |  | return unless $mes->is_success(); | 
| 149 |  |  |  |  |  |  |  | 
| 150 | 0 |  |  |  |  |  | my $ns=$mes->ns('nsgroup'); | 
| 151 | 0 |  |  |  |  |  | my $chkdata=$mes->get_response($ns,'chkData'); | 
| 152 | 0 | 0 |  |  |  |  | return unless defined $chkdata; | 
| 153 |  |  |  |  |  |  |  | 
| 154 | 0 |  |  |  |  |  | foreach my $cd ($chkdata->getChildrenByTagNameNS($ns,'cd')) | 
| 155 |  |  |  |  |  |  | { | 
| 156 | 0 |  |  |  |  |  | my $nsgroup; | 
| 157 | 0 |  |  |  |  |  | foreach my $el (Net::DRI::Util::xml_list_children($cd)) | 
| 158 |  |  |  |  |  |  | { | 
| 159 | 0 |  |  |  |  |  | my ($n,$c)=@$el; | 
| 160 | 0 | 0 |  |  |  |  | if ($n eq 'name') | 
| 161 |  |  |  |  |  |  | { | 
| 162 | 0 |  |  |  |  |  | $nsgroup=$c->textContent(); | 
| 163 | 0 |  |  |  |  |  | $rinfo->{nsgroup}->{$nsgroup}->{exist}=1-Net::DRI::Util::xml_parse_boolean($c->getAttribute('avail')); | 
| 164 | 0 |  |  |  |  |  | $rinfo->{nsgroup}->{$nsgroup}->{action}='check'; | 
| 165 |  |  |  |  |  |  | } | 
| 166 |  |  |  |  |  |  | } | 
| 167 |  |  |  |  |  |  | } | 
| 168 | 0 |  |  |  |  |  | return; | 
| 169 |  |  |  |  |  |  | } | 
| 170 |  |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  | sub info | 
| 172 |  |  |  |  |  |  | { | 
| 173 | 0 |  |  | 0 | 0 |  | my ($epp,$hosts)=@_; | 
| 174 | 0 |  |  |  |  |  | my $mes=$epp->message(); | 
| 175 | 0 |  |  |  |  |  | my @d=build_command($epp,$mes,'info',$hosts); | 
| 176 | 0 |  |  |  |  |  | $mes->command_body(\@d); | 
| 177 | 0 |  |  |  |  |  | return; | 
| 178 |  |  |  |  |  |  | } | 
| 179 |  |  |  |  |  |  |  | 
| 180 |  |  |  |  |  |  | sub info_parse | 
| 181 |  |  |  |  |  |  | { | 
| 182 | 0 |  |  | 0 | 0 |  | my ($po,$otype,$oaction,$oname,$rinfo)=@_; | 
| 183 | 0 |  |  |  |  |  | my $mes=$po->message(); | 
| 184 | 0 | 0 |  |  |  |  | return unless $mes->is_success(); | 
| 185 |  |  |  |  |  |  |  | 
| 186 | 0 |  |  |  |  |  | my $infdata=$mes->get_response($mes->ns('nsgroup'),'infData'); | 
| 187 | 0 | 0 |  |  |  |  | return unless defined $infdata; | 
| 188 |  |  |  |  |  |  |  | 
| 189 | 0 |  |  |  |  |  | my $ns=$po->create_local_object('hosts'); | 
| 190 | 0 |  |  |  |  |  | foreach my $el (Net::DRI::Util::xml_list_children($infdata)) | 
| 191 |  |  |  |  |  |  | { | 
| 192 | 0 |  |  |  |  |  | my ($name,$c)=@$el; | 
| 193 | 0 | 0 |  |  |  |  | if ($name eq 'name') | 
|  |  | 0 |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | { | 
| 195 | 0 |  |  |  |  |  | $oname=$c->textContent(); | 
| 196 | 0 |  |  |  |  |  | $ns->name($oname); | 
| 197 | 0 |  |  |  |  |  | $rinfo->{nsgroup}->{$oname}->{exist}=1; | 
| 198 | 0 |  |  |  |  |  | $rinfo->{nsgroup}->{$oname}->{action}='info'; | 
| 199 |  |  |  |  |  |  | } elsif ($name eq 'ns') | 
| 200 |  |  |  |  |  |  | { | 
| 201 | 0 |  |  |  |  |  | $ns->add($c->textContent()); | 
| 202 |  |  |  |  |  |  | } | 
| 203 |  |  |  |  |  |  | } | 
| 204 |  |  |  |  |  |  |  | 
| 205 | 0 |  |  |  |  |  | $rinfo->{nsgroup}->{$oname}->{self}=$ns; | 
| 206 | 0 |  |  |  |  |  | return; | 
| 207 |  |  |  |  |  |  | } | 
| 208 |  |  |  |  |  |  |  | 
| 209 |  |  |  |  |  |  | ############ Transform commands | 
| 210 |  |  |  |  |  |  |  | 
| 211 |  |  |  |  |  |  | sub create | 
| 212 |  |  |  |  |  |  | { | 
| 213 | 0 |  |  | 0 | 0 |  | my ($epp,$hosts)=@_; | 
| 214 | 0 |  |  |  |  |  | my $mes=$epp->message(); | 
| 215 | 0 |  |  |  |  |  | my @d=build_command($epp,$mes,'create',$hosts); | 
| 216 | 0 |  |  |  |  |  | push @d,add_nsname($hosts); | 
| 217 | 0 |  |  |  |  |  | $mes->command_body(\@d); | 
| 218 | 0 |  |  |  |  |  | return; | 
| 219 |  |  |  |  |  |  | } | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  | sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms) | 
| 222 |  |  |  |  |  |  | { | 
| 223 | 0 |  |  | 0 | 0 |  | my ($epp,$hosts)=@_; | 
| 224 | 0 |  |  |  |  |  | my $mes=$epp->message(); | 
| 225 | 0 |  |  |  |  |  | my @d=build_command($epp,$mes,'delete',$hosts); | 
| 226 | 0 |  |  |  |  |  | $mes->command_body(\@d); | 
| 227 | 0 |  |  |  |  |  | return; | 
| 228 |  |  |  |  |  |  | } | 
| 229 |  |  |  |  |  |  |  | 
| 230 |  |  |  |  |  |  | sub update | 
| 231 |  |  |  |  |  |  | { | 
| 232 | 0 |  |  | 0 | 0 |  | my ($epp,$hosts,$todo)=@_; | 
| 233 | 0 |  |  |  |  |  | my $mes=$epp->message(); | 
| 234 |  |  |  |  |  |  |  | 
| 235 | 0 | 0 |  |  |  |  | Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo); | 
| 236 |  |  |  |  |  |  |  | 
| 237 | 0 | 0 | 0 |  |  |  | if ((grep { ! /^(?:ns)$/ } $todo->types()) || (grep { ! /^(?:set)$/ } $todo->types('ns') )) | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 238 |  |  |  |  |  |  | { | 
| 239 | 0 |  |  |  |  |  | Net::DRI::Exception->die(0,'protocol/EPP',11,'Only ns set available for nsgroup'); | 
| 240 |  |  |  |  |  |  | } | 
| 241 |  |  |  |  |  |  |  | 
| 242 | 0 |  |  |  |  |  | my $ns=$todo->set('ns'); | 
| 243 | 0 |  |  |  |  |  | my @d=build_command($epp,$mes,'update',$hosts); | 
| 244 | 0 |  |  |  |  |  | push @d,add_nsname($ns); | 
| 245 | 0 |  |  |  |  |  | $mes->command_body(\@d); | 
| 246 | 0 |  |  |  |  |  | return; | 
| 247 |  |  |  |  |  |  | } | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | #################################################################################################### | 
| 250 |  |  |  |  |  |  | 1; |