1## Domain Registry Interface, .NO Host extensions 2## 3## Copyright (c) 2008,2010 UNINETT Norid AS, E<lt>http://www.norid.noE<gt>, 4## Trond Haugen E<lt>info@norid.noE<gt> 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# 18#################################################################################################### 19 20package Net::DRI::Protocol::EPP::Extensions::NO::Host; 21 22use strict; 23use warnings; 24 25use Net::DRI::Util; 26 27our $VERSION = do { my @r = ( q$Revision: 1.3 $ =~ /\d+/gmx ); sprintf( "%d" . ".%02d" x $#r, @r ); }; 28 29=pod 30 31=head1 NAME 32 33Net::DRI::Protocol::EPP::Extensions::NO::Host - .NO Host Extensions for Net::DRI 34 35=head1 DESCRIPTION 36 37Please see the README file for details. 38 39=head1 SUPPORT 40 41For now, support questions should be sent to: 42 43E<lt>netdri@dotandco.comE<gt> 44 45Please also see the SUPPORT file in the distribution. 46 47=head1 SEE ALSO 48 49E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt> 50 51=head1 AUTHOR 52 53Trond Haugen, E<lt>info@norid.noE<gt> 54 55=head1 COPYRIGHT 56 57Copyright (c) 2008,2010 UNINETT Norid AS, E<lt>http://www.norid.noE<gt>, 58Trond Haugen E<lt>info@norid.noE<gt> 59All rights reserved. 60 61This program is free software; you can redistribute it and/or modify 62it under the terms of the GNU General Public License as published by 63the Free Software Foundation; either version 2 of the License, or 64(at your option) any later version. 65 66See the LICENSE file that comes with this distribution for more details. 67 68=cut 69 70#################################################################################################### 71 72sub register_commands { 73 my ( $class, $version ) = @_; 74 my %tmp = ( 75 create => [ \&create, undef ], 76 update => [ \&update, undef ], 77 delete => [ \&facet, undef ], 78 check => [ \&facet, undef ], 79 info => [ \&info, \&parse_info ], 80 ); 81 82 return { 'host' => \%tmp }; 83} 84 85#################################################################################################### 86 87##### 88# Facets 89# 90 91sub _build_facet_extension { 92 my ( $mes, $epp, $tag ) = @_; 93 94 return $mes->command_extension_register( 95 $tag, 96 sprintf( 97 'xmlns:no-ext-epp="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('no_epp') 98 ) 99 ); 100} 101 102## 103# This facet method is generic and can be called from all object operations 104# 105sub build_facets { 106 my ( $epp, $rd ) = @_; 107 108 my @e; 109 my $eid; 110 111 my $mes = $epp->message(); 112 if (exists($rd->{facets}) && defined($rd->{facets})) { 113 $eid = _build_facet_extension( $mes, $epp, 'no-ext-epp:extended' ); 114 foreach my $fkey (keys(%{$rd->{facets}})) { 115 push @e, [ 'no-ext-epp:facet', { name => $fkey }, $rd->{facets}->{$fkey} ]; 116 } 117 } 118 return $mes->command_extension( $eid, \@e ) if (@e); 119} 120 121 122sub facet { 123 my ( $epp, $o, $rd ) = @_; 124 125 return build_facets( $epp, $rd ); 126} 127 128 129sub parse_info { 130 my ( $po, $otype, $oaction, $oname, $rinfo ) = @_; 131 my $mes = $po->message(); 132 return unless $mes->is_success(); 133 134 my $NS = $mes->ns('no_host'); 135 136 my $condata = $mes->get_extension('no_host','infData'); 137 return unless $condata; 138 139 my @e = $condata->getElementsByTagNameNS( $NS, 'contact' ); 140 return unless @e; 141 142 # Contact is a single scalar 143 my $t = $e[0]; 144 if ( my $ct = $t->getFirstChild()->getData() ) { 145 $rinfo->{host}->{$oname}->{contact} = $ct; 146 } 147 return; 148} 149 150sub build_command_extension { 151 my ( $mes, $epp, $tag ) = @_; 152 153 return $mes->command_extension_register( 154 $tag, 155 sprintf( 156 'xmlns:no-ext-host="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('no_host') 157 ) 158 ); 159} 160 161 162 163sub info { 164 my ( $epp, $ho, $rd ) = @_; 165 my $mes = $epp->message(); 166 167 my $si; 168 $si = $rd->{sponsoringclientid} if (exists($rd->{sponsoringclientid})); 169 my $fs; 170 $fs = $rd->{facets} if (exists($rd->{facets})); 171 172 return unless ( $si || $fs ); 173 174 my $r; 175 176 if ($si) { 177 my $eid = build_command_extension( $mes, $epp, 'no-ext-host:info' ); 178 my @e; 179 push @e, [ 'no-ext-host:sponsoringClientID', $si ]; 180 $r = $mes->command_extension( $eid, \@e ); 181 } 182 if ($fs) { 183 $r = facet( $epp, $ho, $rd ); 184 } 185 186 return $r; 187} 188 189sub create { 190 my ( $epp, $ho, $rd ) = @_; 191 my $mes = $epp->message(); 192 193 return unless ((exists($rd->{contact}) && defined($rd->{contact})) || (exists($rd->{facets}) && defined($rd->{facets}))); 194 195 my $r; 196 197 if (exists($rd->{contact}) && defined($rd->{contact})) { 198 my @e; 199 my $eid = build_command_extension( $mes, $epp, 'no-ext-host:create' ); 200 my $c = $rd->{contact}; 201 my $srid; 202 203 # $c may be a contact object or a direct scalar 204 if ( Net::DRI::Util::has_contact( $rd ) ) 205 { 206 my @o = $c->get('contact'); 207 $srid = $o[0]->srid() if (@o); 208 } else { 209 210 # Contact shall be a single scalar! 211 $srid = $c; 212 } 213 push @e, [ 'no-ext-host:contact', $srid ]; 214 $r = $mes->command_extension( $eid, \@e ); 215 } 216 217 # Add facet if any is set 218 if (exists($rd->{facets}) && defined($rd->{facets})) { 219 $r = facet( $epp, $ho, $rd ); 220 } 221 222 return $r; 223} 224 225sub update { 226 my ( $epp, $ho, $todo ) = @_; 227 my $mes = $epp->message(); 228 229 my $ca = $todo->add('contact'); 230 my $cd = $todo->del('contact'); 231 my $fs = $todo->set('facets'); 232 233 return unless ( $ca || $cd || $fs); # No updates asked 234 235 my $r; 236 237 if ( $ca || $cd ) { 238 my $eid = build_command_extension( $mes, $epp, 'no-ext-host:update' ); 239 240 my ( @n, @s ); 241 242 if ( defined($ca) && $ca ) { 243 push @s, [ 'no-ext-host:contact', $ca ]; 244 push @n, [ 'no-ext-host:add', @s ] if ( @s > 0 ); 245 } 246 @s = undef; 247 if ( defined($cd) && $cd ) { 248 push @s, [ 'no-ext-host:contact', $cd ]; 249 push @n, [ 'no-ext-host:rem', @s ] if ( @s > 0 ); 250 } 251 $r = $mes->command_extension( $eid, \@n ); 252 } 253 254 # Add facet if any is set 255 if ($fs) { 256 my $rd; 257 $rd->{facets} = $fs; 258 $r = facet( $epp, $ho, $rd ); 259 } 260 return $r; 261} 262 263#################################################################################################### 2641; 265