File Coverage

blib/lib/Net/DRI/Data/Contact.pm
Criterion Covered Total %
statement 73 144 50.6
branch 25 78 32.0
condition 5 71 7.0
subroutine 18 22 81.8
pod 6 11 54.5
total 127 326 38.9


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Handling of contact data
2             ##
3             ## Copyright (c) 2005-2010,2013-2015 Patrick Mevzek . All rights reserved.
4             ##
5             ## This file is part of Net::DRI
6             ##
7             ## Net::DRI is free software; you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation; either version 2 of the License, or
10             ## (at your option) any later version.
11             ##
12             ## See the LICENSE file that comes with this distribution for more details.
13             #########################################################################################
14              
15             package Net::DRI::Data::Contact;
16              
17 61     61   2210 use utf8;
  61         113  
  61         476  
18 61     61   1824 use strict;
  61         97  
  61         2169  
19 61     61   301 use warnings;
  61         113  
  61         1803  
20              
21 61     61   274 use base qw(Class::Accessor::Chained); ## provides a new() method
  61         96  
  61         33037  
22              
23             our @ATTRS=qw(name org street city sp pc cc email voice fax loid roid srid auth disclose);
24             __PACKAGE__->register_attributes(@ATTRS);
25              
26 61     61   30323 use Net::DRI::Exception;
  61         112  
  61         1228  
27 61     61   1236 use Net::DRI::Util;
  61         99  
  61         1161  
28              
29 61     61   33848 use Email::Valid;
  61         4429851  
  61         2514  
30 61     61   550 use Encode (); ## we need here direct use of Encode, not through Net::DRI::Util::encode_* as we need the default substitution for unknown data
  61         95  
  61         6088  
31              
32             =pod
33              
34             =head1 NAME
35              
36             Net::DRI::Data::Contact - Handle contact data, modeled from EPP for Net::DRI
37              
38             =head1 DESCRIPTION
39              
40             This base class encapsulates all data for a contact as defined in EPP (RFC4933).
41             It can (and should) be subclassed for TLDs needing to store other data for a contact.
42             All subclasses must have a validate() method that takes care of verifying contact data,
43             and an id() method returning an opaque value, unique per contact (in a given registry).
44              
45             The following methods are both accessors and mutators :
46             as mutators, they can be called in chain, as they all return the object itself.
47              
48             Postal information through name() org() street() city() sp() pc() cc() can be provided twice.
49             EPP allows a localized form (content is in unrestricted UTF-8) and internationalized form
50             (content MUST be represented in a subset of UTF-8 that can be represented
51             in the 7-bit US-ASCII character set). Not all registries support both forms.
52              
53             When setting values, you pass two elements as a list (first the localized form,
54             then the internationalized one), or only one element that will be taken as the localized form.
55             When getting values, in list context you get back both values, in scalar context you get
56             back the first one, that is the localized form.
57              
58             You can also use methods int2loc() and loc2int() to create one version from the other.
59             These 2 methods may be used automatically inside Net::DRI as needed, depending on what
60             the registry expects and the operation conducted (like a contact create).
61              
62             =head1 METHODS
63              
64             =head2 loid()
65              
66             local object ID for this contact, never sent to registry (can be used to track the local db id of this object)
67              
68             =head2 srid()
69              
70             server ID, ID of the object as known by the registry in which it was created
71              
72             =head2 id()
73              
74             an alias (needed for Net::DRI::Data::ContactSet) of the previous method
75              
76             =head2 roid()
77              
78             registry/remote object id (internal to a registry)
79              
80             =head2 name()
81              
82             name of the contact
83              
84             =head2 org()
85              
86             organization of the contact
87              
88             =head2 street()
89              
90             street address of the contact (ref array of up to 3 elements)
91              
92             =head2 city()
93              
94             city of the contact
95              
96             =head2 sp()
97              
98             state/province of the contact
99              
100             =head2 pc()
101              
102             postal code of the contact
103              
104             =head2 cc()
105              
106             alpha2 country code of the contact (will be verified against list of valid country codes)
107              
108             =head2 email()
109              
110             email address of the contact
111              
112             =head2 voice()
113              
114             voice number of the contact (in the form +CC.NNNNNNNNxEEE)
115              
116             =head2 fax()
117              
118             fax number of the contact (same form as above)
119              
120             =head2 auth()
121              
122             authentication for this contact (hash ref with a key 'pw' and a value being the password)
123              
124             =head2 disclose()
125              
126             privacy settings related to this contact (see RFC)
127              
128             =head2 int2loc()
129              
130             create the localized part from the internationalized part ; existing internationalized data is overwritten
131              
132             =head2 loc2int()
133              
134             create the internationalized part from the localized part ; existing localized data is overwritten ;
135             as the internationalized part must be a subset of UTF-8 when the localized one can be the full UTF-8,
136             this operation may creates undefined characters (?) as result
137              
138             =head2 as_string()
139              
140             return a string formed with all data contained in this contact object ; this is mostly useful for debugging and logging, this
141             string should not be parsed as its format is not guaranteed to remain stable, you should use the above accessors
142              
143             =head2 attributes()
144              
145             return an array of attributes name available in this contact object (taking into account any subclass specific attribute)
146              
147             =head1 SUPPORT
148              
149             For now, support questions should be sent to:
150              
151             Enetdri@dotandco.comE
152              
153             Please also see the SUPPORT file in the distribution.
154              
155             =head1 SEE ALSO
156              
157             http://www.dotandco.com/services/software/Net-DRI/
158              
159             =head1 AUTHOR
160              
161             Patrick Mevzek, Enetdri@dotandco.comE
162              
163             =head1 COPYRIGHT
164              
165             Copyright (c) 2005-2010,2013-2015 Patrick Mevzek .
166             All rights reserved.
167              
168             This program is free software; you can redistribute it and/or modify
169             it under the terms of the GNU General Public License as published by
170             the Free Software Foundation; either version 2 of the License, or
171             (at your option) any later version.
172              
173             See the LICENSE file that comes with this distribution for more details.
174              
175             =cut
176              
177             ####################################################################################################
178             ## Needed for ContactSet
179 18     18 1 336 sub id { my ($self,@args)=@_; return $self->srid(@args); }
  18         32  
180              
181             sub register_attributes
182             {
183 92     92 0 301 my ($class,@a)=@_;
184 92         946 __PACKAGE__->mk_accessors(@a);
185 61     61   299 no strict 'refs'; ## no critic (ProhibitNoStrict)
  61         100  
  61         5887  
186 92 100       35213 ${$class.'::ATTRS'}=($class eq 'Net::DRI::Data::Contact')? \@a : [ @ATTRS,@a ];
  92         408  
187 92         145 return ${$class.'::ATTRS'};
  92         276  
188             }
189              
190             sub attributes
191             {
192 0     0 1 0 my $class=shift;
193 0   0     0 $class=ref($class) || $class;
194 61     61   296 no strict 'refs'; ## no critic (ProhibitNoStrict)
  61         117  
  61         98439  
195 0         0 return @{${$class.'::ATTRS'}};
  0         0  
  0         0  
196             }
197              
198             ## Overrides method in Class::Accessor, needed for int/loc data
199             sub get
200             {
201 70     70 1 2339 my ($self,$what)=@_;
202 70 100 33     390 return unless defined $what && $what && exists $self->{$what};
      66        
203 40         50 my $d=$self->{$what};
204 40 100       194 return $d unless ($what=~m/^(name|org|street|city|sp|pc|cc)$/);
205              
206             ## Special case for street because it is always a ref array, but a complicate one, we have either
207             ## [ X, Y, Z ] (with Y and/or Z optional)
208             ## [ undef, [ X, Y, Z ] ]
209             ## [ [ X, Y, Z ] , undef ]
210             ## [ [ X, Y, Z ], [ XX, YY, ZZ ] ]
211             ## [ undef, undef ]
212 22 100       45 if ($what eq 'street')
213             {
214 9 50       20 Net::DRI::Exception::usererr_invalid_parameters('Invalid street information, should be one or two ref arrays of up to 3 elements each') unless ref $d eq 'ARRAY';
215 9 100       13 return wantarray ? ($d, undef) : $d unless 2==grep { ! defined $_ || ref $_ eq 'ARRAY' } @$d;
  22 50       105  
    100          
216             } else
217             {
218 13 100       41 return $d unless ref $d eq 'ARRAY';
219             }
220 15 100       67 return wantarray ? @$d : $d->[0];
221             }
222              
223             sub loc2int
224             {
225 1     1 1 21 my $self=shift;
226 1         3 foreach my $f (qw/name org city sp pc cc/)
227             {
228 6         48 my @c=$self->$f();
229 6 100       14 $c[1]=defined $c[0] ? Encode::encode('ascii',$c[0],0) : undef;
230 6         47 $self->$f(@c);
231             }
232 1         11 my @c=$self->street();
233 1 50       4 if (defined $c[0])
234             {
235 0 0       0 $c[1]=[ map { defined $_ ? Encode::encode('ascii',$_,0) : undef } @{$c[0]} ];
  0         0  
  0         0  
236             } else
237             {
238 1         2 $c[1]=$c[0]=[];
239             }
240 1         3 $self->street(@c);
241 1         7 return $self;
242             }
243              
244             sub int2loc
245             {
246 1     1 1 3 my $self=shift;
247 1         3 foreach my $f (qw/name org street city sp pc cc/)
248             {
249 7         90 my @c=$self->$f();
250 7         11 $c[0]=$c[1]; ## internationalized form is a subset of UTF-8 and localized form is full UTF-8
251 7         21 $self->$f(@c);
252             }
253 1         15 return $self;
254             }
255              
256 2     2 0 5 sub has_loc { return shift->_has(0); }
257 2     2 0 6 sub has_int { return shift->_has(1); }
258             sub _has
259             {
260 4     4   5 my ($self,$pos)=@_;
261 4         6 my @d=map { ($self->$_())[$pos] } qw/name org city sp pc cc/;
  24         50  
262 4         8 my $s=($self->street())[$pos];
263 4 100 66     18 push @d,@$s if defined $s && ref $s eq 'ARRAY';
264 4 100       9 return (grep { defined } @d)? 1 : 0;
  9         19  
265             }
266              
267             sub validate ## See RFC4933,ยง4
268             {
269 0     0 0   my ($self,$change)=@_;
270 0   0       $change||=0;
271 0           my @errs;
272              
273 0 0         if (!$change)
274             {
275 0 0 0       my @missing=grep { my $r=scalar $self->$_(); (defined $r && length $r)? 0 : 1 } qw/name city cc email auth srid/;
  0            
  0            
276 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Mandatory contact information missing: '.join('/',@missing)) if @missing;
277 0 0         push @errs,'srid' unless Net::DRI::Util::xml_is_token($self->srid(),3,16);
278             }
279              
280 0 0 0       push @errs,'srid' if ($self->srid() && ! Net::DRI::Util::xml_is_token($self->srid(),3,16));
281 0 0 0       push @errs,'name' if ($self->name() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,1,255) } ($self->name()));
  0            
282 0 0 0       push @errs,'org' if ($self->org() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,undef,255) } ($self->org()));
  0            
283              
284 0           my @rs=($self->street());
285 0           foreach my $i (0,1)
286             {
287 0 0         next unless defined $rs[$i];
288 0 0 0       push @errs,'street' if ((ref($rs[$i]) ne 'ARRAY') || (@{$rs[$i]} > 3) || (grep { !Net::DRI::Util::xml_is_normalizedstring($_,undef,255) } @{$rs[$i]}));
  0   0        
  0            
  0            
289             }
290              
291 0 0 0       push @errs,'city' if ($self->city() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,1,255) } ($self->city()));
  0            
292 0 0 0       push @errs,'sp' if ($self->sp() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,undef,255) } ($self->sp()));
  0            
293 0 0 0       push @errs,'pc' if ($self->pc() && grep { !Net::DRI::Util::xml_is_token($_,undef,16) } ($self->pc()));
  0            
294 0 0 0       push @errs,'cc' if ($self->cc() && grep { !Net::DRI::Util::xml_is_token($_,2,2) } ($self->cc()));
  0            
295 0 0 0       push @errs,'cc' if ($self->cc() && grep { !exists($Net::DRI::Util::CCA2{uc($_)}) } ($self->cc()));
  0            
296              
297 0 0 0       push @errs,'voice' if ($self->voice() && ! ($self->voice()=~m/^\+[0-9]{1,3}\.[0-9]{1,14}(?:x\d+)?$/));
298 0 0 0       push @errs,'fax' if ($self->fax() && ! ($self->fax()=~m/^\+[0-9]{1,3}\.[0-9]{1,14}(?:x\d+)?$/));
299 0 0 0       push @errs,'email' if ($self->email() && ! (Net::DRI::Util::xml_is_token($self->email(),1,undef) && Email::Valid->rfc822($self->email())));
      0        
300              
301 0           my $ra=$self->auth();
302 0 0 0       push @errs,'auth' if ($ra && (ref($ra) eq 'HASH') && exists($ra->{pw}) && !Net::DRI::Util::xml_is_normalizedstring($ra->{pw}));
      0        
      0        
303              
304             ## Nothing checked for disclose
305              
306 0 0         Net::DRI::Exception::usererr_invalid_parameters('Invalid contact information: '.join('/',@errs)) if @errs;
307 0           return 1; ## everything ok.
308             }
309              
310             sub as_string
311             {
312 0     0 1   my ($self,$sep)=@_;
313 0 0 0       $sep='|' unless (defined($sep) && $sep);
314 0           my $st=$self->street();
315 0 0         my @v=grep { defined } ($self->srid(),$self->name(),$self->org(),defined($st)? join(' // ',@$st) : undef,$self->city(),$self->sp(),$self->pc(),$self->cc(),$self->voice(),$self->fax(),$self->email());
  0            
316 0           my @ot=sort { $a cmp $b } grep { ! /^(?:name|org|street|city|sp|pc|cc|email|voice|fax|loid|roid|srid|auth|disclose)$/ } keys %$self;
  0            
  0            
317 0           foreach my $ot (@ot) ## extra attributes defined in subclasses
318             {
319 0           my $v=$self->$ot();
320 0 0         next unless defined($v);
321 0 0         if (ref($v) eq 'HASH')
322             {
323 0           my @iv=sort { $a cmp $b } keys %$v;
  0            
324 0           my @r;
325 0           foreach my $k (@iv)
326             {
327 0 0         push @r,sprintf('%s.%s=%s',$ot,$k,defined($v->{$k})? $v->{$k} : '');
328             }
329 0           push @v,join(' ',@r);
330             } else
331             {
332 0           push @v,$ot.'='.$v;
333             }
334             }
335              
336 0           my $c=ref($self);
337 0           $c=~s/^Net::DRI::Data:://;
338 0           return '('.$c.') '.join($sep,@v);
339             }
340              
341             sub clone
342             {
343 0     0 0   my ($self)=@_;
344 0           my $new=Net::DRI::Util::deepcopy($self);
345 0           return $new;
346             }
347              
348             ####################################################################################################
349             1;