File Coverage

blib/lib/Net/DRI/Data/Contact/SWITCH.pm
Criterion Covered Total %
statement 18 58 31.0
branch 0 40 0.0
condition 0 66 0.0
subroutine 6 8 75.0
pod 0 2 0.0
total 24 174 13.7


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Handling of contact data for .CH/.LI
2             ##
3             ## Copyright (c) 2008,2009,2013 Tonnerre Lombard .
4             ## 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::Data::Contact::SWITCH;
17              
18 1     1   929 use strict;
  1         2  
  1         29  
19 1     1   4 use warnings;
  1         1  
  1         25  
20 1     1   3 use base qw/Net::DRI::Data::Contact/;
  1         2  
  1         70  
21              
22 1     1   4 use Net::DRI::Exception;
  1         1  
  1         16  
23 1     1   11 use Net::DRI::Util;
  1         2  
  1         26  
24 1     1   4 use Email::Valid;
  1         1  
  1         611  
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Data::Contact::SWITCH - Handle .CH/.LI contact data for Net::DRI
31              
32             =head1 DESCRIPTION
33              
34             This subclass of Net::DRI::Data::Contact adds accessors and validation for
35             .CH/.LI specific data.
36              
37             =head1 SUPPORT
38              
39             For now, support questions should be sent to:
40              
41             Etonnerre.lombard@sygroup.chE
42              
43             Please also see the SUPPORT file in the distribution.
44              
45             =head1 SEE ALSO
46              
47             http://oss.bsdprojects.net/projects/netdri/ or
48             http://www.dotandco.com/services/software/Net-DRI/
49              
50             =head1 AUTHOR
51              
52             Tonnerre Lombard, Etonnerre.lombard@sygroup.chE
53              
54             =head1 COPYRIGHT
55              
56             Copyright (c) 2008,2009,2013 Tonnerre Lombard .
57             All rights reserved.
58              
59             This program is free software; you can redistribute it and/or modify
60             it under the terms of the GNU General Public License as published by
61             the Free Software Foundation; either version 2 of the License, or
62             (at your option) any later version.
63              
64             See the LICENSE file that comes with this distribution for more details.
65              
66             =cut
67              
68             ####################################################################################################
69              
70             sub validate
71             {
72 0     0 0   my ($self,$change)=@_;
73 0   0       $change||=0;
74 0           my @errs;
75              
76 0 0         if (!$change)
77             {
78 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('Invalid contact information: name/city/cc/email/srid mandatory') unless (scalar(($self->name())[1]) && scalar(($self->city())[1]) && scalar(($self->cc())[1]) && $self->email() && $self->srid());
      0        
      0        
      0        
79              
80 0 0         push @errs,'srid' unless Net::DRI::Util::xml_is_token($self->srid(),3,16);
81             }
82              
83 0 0 0       push @errs,'srid' if ($self->srid() && $self->srid()!~m/^\w{1,80}-\w{1,8}$/); ## \w includes _ in Perl
84 0 0 0       push @errs,'name' if ($self->name() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,1,255) } ($self->name()));
  0            
85 0 0 0       push @errs,'org' if ($self->org() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,undef,255) } ($self->org()));
  0            
86              
87 0           my @rs=($self->street());
88 0           foreach my $i (0,1)
89             {
90 0 0         next unless $rs[$i];
91 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            
92             }
93              
94 0 0 0       push @errs,'city' if ($self->city() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,1,255) } ($self->city()));
  0            
95 0 0 0       push @errs,'sp' if ($self->sp() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,undef,255) } ($self->sp()));
  0            
96 0 0 0       push @errs,'pc' if ($self->pc() && grep { !Net::DRI::Util::xml_is_token($_,undef,16) } ($self->pc()));
  0            
97 0 0 0       push @errs,'cc' if ($self->cc() && grep { !Net::DRI::Util::xml_is_token($_,2,2) } ($self->cc()));
  0            
98 0 0 0       push @errs,'cc' if ($self->cc() && grep { !exists($Net::DRI::Util::CCA2{uc($_)}) } ($self->cc()));
  0            
99              
100 0 0 0       push @errs,'voice' if ($self->voice() && !Net::DRI::Util::xml_is_token($self->voice(),undef,17) && $self->voice()!~m/^\+[0-9]{1,3}\.[0-9]{1,14}(?:x\d+)?$/);
      0        
101 0 0 0       push @errs,'fax' if ($self->fax() && !Net::DRI::Util::xml_is_token($self->fax(),undef,17) && $self->fax()!~m/^\+[0-9]{1,3}\.[0-9]{1,14}(?:x\d+)?$/);
      0        
102 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        
103              
104 0           $self->auth({pw => ''});
105              
106 0 0         Net::DRI::Exception::usererr_invalid_parameters('Invalid contact information: '.join('/',@errs)) if @errs;
107              
108 0           return 1; ## everything ok.
109             }
110              
111             sub init
112             {
113 0     0 0   my ($self,$what,$ndr)=@_;
114              
115 0 0         if ($what eq 'create')
116             {
117 0           my $a=$self->auth();
118 0 0 0       $self->auth({pw=>''}) unless ($a && (ref($a) eq 'HASH') && exists($a->{pw})); ## Mandatory in EPP, not used by .CH/.LI
      0        
119 0 0         $self->srid('auto') unless defined($self->srid()); ## we can not choose the ID
120             }
121 0           return;
122             }
123              
124             ####################################################################################################
125             1;