File Coverage

blib/lib/Net/DRI/Data/Contact/NO.pm
Criterion Covered Total %
statement 21 94 22.3
branch 0 82 0.0
condition 0 113 0.0
subroutine 7 9 77.7
pod 0 2 0.0
total 28 300 9.3


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Handling of contact data for .NO
2             ##
3             ## Copyright (c) 2008-2011,2014 UNINETT Norid AS, Ehttp://www.norid.noE,
4             ## Trond Haugen Einfo@norid.noE.
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             package Net::DRI::Data::Contact::NO;
18              
19 1     1   884 use utf8;
  1         2  
  1         5  
20 1     1   26 use strict;
  1         1  
  1         16  
21 1     1   3 use warnings;
  1         2  
  1         23  
22 1     1   3 use base qw/Net::DRI::Data::Contact/;
  1         1  
  1         67  
23 1     1   4 use Email::Valid;
  1         2  
  1         23  
24 1     1   7 use Net::DRI::Util;
  1         1  
  1         17  
25 1     1   3 use Net::DRI::Exception;
  1         2  
  1         1126  
26              
27             __PACKAGE__->register_attributes(qw(type identity mobilephone organization rolecontact xemail xdisclose facets));
28              
29             =pod
30              
31             =encoding utf8
32              
33             =head1 NAME
34              
35             Net::DRI::Data::Contact::NO - Handle .NO contact data for Net::DRI
36              
37             =head1 DESCRIPTION
38              
39             This subclass of Net::DRI::Data::Contact adds accessors and validation for
40             .NO specific data.
41              
42             =head1 METHODS
43              
44             The following accessors/mutators can be called in chain, as they all return
45             the object itself.
46              
47             =head2 type()
48              
49             Mandatory, must be set for all contacts. Specify what type of contact to
50             register. Value must be one of: 'person', 'organization' or 'role'.
51              
52             Example: $co->type('organization')
53              
54             =head2 identity()
55              
56             Currently valid for type='organization' only.
57             Must then be set to specify the organization number in Brønnøysund,
58             the Norwegian Business Register.
59              
60             Example: $co->identity({type=>'organizationNumber', value=>'987654321'});
61              
62             =head2 mobilephone()
63              
64             Optional. Set a mobile phone number for the contact.
65              
66             Example: $co->mobilephone('+47.123456780')
67              
68             =head2 organization()
69              
70             Optional. Set one or more organization-elements which specify organizations
71             which the contact belongs to. The value should be the local contact id
72             of an organization object.
73              
74             This element can only be used for role and person contacts.
75              
76             $co->organization('EFA12O');
77              
78             =head2 rolecontact()
79              
80             Optional. Set one or more roleContact-elements which specify persons which
81             belongs to a role contact. The value should be the local contact id of a
82             person object.
83              
84             This element can only be used for role contacts.
85              
86             Example: $co->rolecontact(['JD12P', 'JD13P']);
87              
88             =head2 xemail()
89              
90             Optional. Set one or more email-elements which specify email addresses in
91             addition to the mandatory email element in the standard contact create command.
92              
93             Example: $co->xemail(['xtra1@example.no', 'xtra2@example.no']);
94              
95             =head2 xdisclose()
96              
97             Optional. A disclose-element which must contain the child element mobilePhone.
98             This element notes the clients preference to allow or restrict disclosure of
99             the mobile phone number. If not present, the servers stated data collection
100             policy is used.
101              
102             Example: $co->xdisclose({mobilePhone=>0});
103              
104             =head2 facets()
105             Facets are some special control attributes that can be used to
106             implement a super registrar (admin registrar).
107              
108             A super registrar can suppress certain checks and perform actions on behalf of a normal registrar.
109              
110             Facets are key/values pairs.
111             Net::DRI will not try to enforce what key/value pairs that are possible,
112             but let the registry decide their validity.
113              
114             Example: $co->facets( { 'skip-manual-review' => 1, 'ignores-exceptions' => 'reg123'} );
115              
116              
117             =head1 SUPPORT
118              
119             For now, support questions should be sent to:
120              
121             Enetdri@dotandco.comE
122              
123             Please also see the SUPPORT file in the distribution.
124              
125             =head1 SEE ALSO
126              
127             http://www.dotandco.com/services/software/Net-DRI/
128              
129             =head1 AUTHOR
130              
131             Trond Haugen, Einfo@norid.noE.
132              
133             =head1 COPYRIGHT
134              
135             Copyright (c) 2008-2010,2014 UNINETT Norid AS, Ehttp://www.norid.noE,
136             Trond Haugen Einfo@norid.noE.
137             All rights reserved.
138              
139             This program is free software; you can redistribute it and/or modify
140             it under the terms of the GNU General Public License as published by
141             the Free Software Foundation; either version 2 of the License, or
142             (at your option) any later version.
143              
144             See the LICENSE file that comes with this distribution for more details.
145              
146             =cut
147              
148             ####################################################################################################
149              
150             sub validate {
151 0     0 0   my ( $self, $change ) = @_;
152 0   0       $change ||= 0;
153              
154 0           my @errs;
155              
156 0 0         if ( !$change ) {
157 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters(
      0        
      0        
      0        
      0        
158             'Invalid contact information: name/city/cc/email/auth/srid mandatory'
159             )
160             unless $self->name()
161             && $self->city()
162             && $self->cc()
163             && $self->email()
164             && $self->auth()
165             && $self->srid();
166 0 0         Net::DRI::Exception::usererr_insufficient_parameters(
167             'Invalid contact information: org is not allowed for .NO')
168             if ( $self->org() );
169 0 0         Net::DRI::Exception::usererr_insufficient_parameters(
170             'Invalid contact information: type mandatory')
171             unless ( $self->type() );
172             }
173              
174 0 0 0       push @errs,'srid' if ($self->srid() && ! Net::DRI::Util::xml_is_token($self->srid(),3,16));
175             push @errs, 'name'
176             if ( $self->name()
177 0 0 0       && grep { !Net::DRI::Util::xml_is_normalizedstring( $_, 1, 255 ) }
  0            
178             ( $self->name() ) );
179             push @errs, 'org'
180             if ( $self->org()
181 0 0 0       && grep { !Net::DRI::Util::xml_is_normalizedstring( $_, undef, 255 ) }
  0            
182             ( $self->org() ) );
183              
184 0           my @rs = ( $self->street() );
185              
186 0           foreach my $i ( 0, 1 ) {
187 0 0         next unless $rs[$i];
188             push @errs, 'street'
189             if (
190 0           ( ref( $rs[$i] ) ne 'ARRAY' ) || ( @{ $rs[$i] } > 3 ) || (
191             grep {
192 0           !Net::DRI::Util::xml_is_normalizedstring( $_, undef, 255 )
193 0 0 0       } @{ $rs[$i] }
  0   0        
194             )
195             );
196             }
197              
198             push @errs, 'city'
199             if ( $self->city()
200 0 0 0       && grep { !Net::DRI::Util::xml_is_normalizedstring( $_, 1, 255 ) }
  0            
201             ( $self->city() ) );
202             push @errs, 'sp'
203             if ( $self->sp()
204 0 0 0       && grep { !Net::DRI::Util::xml_is_normalizedstring( $_, undef, 255 ) }
  0            
205             ( $self->sp() ) );
206             push @errs, 'pc'
207             if ( $self->pc()
208 0 0 0       && grep { !Net::DRI::Util::xml_is_token( $_, undef, 16 ) }
  0            
209             ( $self->pc() ) );
210             push @errs, 'cc'
211 0 0 0       if ( $self->cc() && grep { !Net::DRI::Util::xml_is_token( $_, 2, 2 ) }
  0            
212             ( $self->cc() ) );
213             push @errs, 'cc'
214             if ( $self->cc()
215 0 0 0       && grep { !exists( $Net::DRI::Util::CCA2{ uc($_) } ) }
  0            
216             ( $self->cc() ) );
217              
218 0 0 0       push @errs, 'voice'
      0        
219             if ( $self->voice()
220             && !Net::DRI::Util::xml_is_token( $self->voice(), undef, 17 )
221             && $self->voice() !~ m/^\+[0-9]{1,3}\.[0-9]{1,14}(?:x\d+)?$/mx );
222 0 0 0       push @errs, 'fax'
      0        
223             if ( $self->fax()
224             && !Net::DRI::Util::xml_is_token( $self->fax(), undef, 17 )
225             && $self->fax() !~ m/^\+[0-9]{1,3}\.[0-9]{1,14}(?:x\d+)?$/mx );
226 0 0 0       push @errs, 'email'
      0        
227             if (
228             $self->email()
229             && !(
230             Net::DRI::Util::xml_is_token( $self->email(), 1, undef )
231             && Email::Valid->rfc822( $self->email() )
232             )
233             );
234              
235 0           my $ra = $self->auth();
236             push @errs, 'auth'
237             if ( $ra
238             && ( ref($ra) eq 'HASH' )
239             && exists( $ra->{pw} )
240 0 0 0       && !Net::DRI::Util::xml_is_normalizedstring( $ra->{pw} ) );
      0        
      0        
241              
242             # .NO
243 0           my $t = $self->type();
244 0 0 0       push @errs, 'type' if ( $t && $t !~ m/^(?:person|organization|role)$/mx );
245              
246 0           $t = $self->identity();
247              
248 0 0         if ($t) {
249 0           my $ty = $t->{type};
250 0           my $va = $t->{value};
251 0 0 0       push @errs, 'identity type'
252             if ( $ty
253             && $ty
254             !~ m/^(?:organizationNumber|localIdentity|nationalIdentityNumber|anonymousPersonIdentifier)$/mx
255             );
256              
257             # let the server handle further validation of what identity syntax
258             # and values are legal
259             }
260 0           $t = $self->mobilephone();
261 0 0 0       push @errs, 'mobilephone'
      0        
262             if ( $t
263             && !Net::DRI::Util::xml_is_token( $t, undef, 17 )
264             && $t !~ m/^\+[0-9]{1,3}\.[0-9]{1,14}(?:x\d+)?$/mx );
265              
266             #
267 0           foreach my $el ( 'organization', 'rolecontact', 'xemail' ) {
268 0 0         if ( $t = $self->$el() ) { # option, as scalar or array
269 0           my @em;
270             my $er;
271              
272 0 0         if ($change) {
273 0 0         if ( ref($t) eq 'HASH' ) {
274 0           foreach my $s ( 'add', 'del' ) {
275 0           my $e = $t->{$s};
276 0 0         if ( ref($e) eq 'ARRAY' ) {
277 0 0         push @em, @$e if (@$e);
278             } else {
279 0 0         push @em, $e if ($e);
280             }
281             }
282             } else {
283 0           $er .= ":update needs an add/del hash:";
284             }
285             } else {
286 0 0         if ( ref($t) eq 'ARRAY' ) {
287 0 0         push @em, @$t if (@$t);
288             } else {
289 0 0         push @em, $t if ($t);
290             }
291             }
292 0           foreach my $e (@em) {
293 0 0         if ( $el eq 'xemail' ) {
294 0 0 0       $er .= " $e "
      0        
295             if (
296             $e
297             && !(
298             Net::DRI::Util::xml_is_token( $e, 1, undef )
299             && Email::Valid->rfc822($e)
300             )
301             );
302             } else {
303 0 0 0       $er .= " $e "
304             if ( $e
305             && !Net::DRI::Util::xml_is_token( $e, 3, 16 ) );
306             }
307 0 0         push @errs, "$el:$er" if ($er);
308             }
309             }
310             }
311              
312             ## Check that xdisclose only contains mobilePhone
313 0 0         if ( my $d = $self->xdisclose() ) {
314 0 0 0       unless ( $d
      0        
      0        
      0        
315             && ( ref($d) eq 'HASH' )
316             && ( scalar( keys(%$d) ) == 1 )
317             && ( $d->{mobilePhone} == 1 || $d->{mobilePhone} == 0 ) )
318             {
319 0           push @errs, 'xdisclose';
320             }
321             }
322             Net::DRI::Exception::usererr_invalid_parameters(
323 0 0         'Invalid contact information: ' . join( '/', @errs ) )
324             if @errs;
325 0           return 1; ## everything ok.
326             }
327              
328             sub init {
329 0     0 0   my ( $self, $what, $ndr ) = @_;
330              
331 0 0         if ( $what eq 'create' ) {
332 0           my $a = $self->auth();
333             $self->auth( { pw => '' } )
334 0 0 0       unless ( $a && ( ref($a) eq 'HASH' ) && exists( $a->{pw} ) )
      0        
335             ; ## Mandatory in EPP
336 0 0         $self->srid('auto')
337             unless defined( $self->srid() ); ## we can not choose the ID
338             }
339 0           return;
340             }
341              
342             ####################################################################################################
343             1;