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