File Coverage

blib/lib/Net/DRI/Protocol/Whois/Domain/common.pm
Criterion Covered Total %
statement 9 95 9.4
branch 0 50 0.0
condition 0 30 0.0
subroutine 3 9 33.3
pod 0 6 0.0
total 12 190 6.3


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Whois common parse subroutines
2             ##
3             ## Copyright (c) 2007-2009,2012-2013 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::Protocol::Whois::Domain::common;
16              
17 1     1   669 use strict;
  1         2  
  1         29  
18 1     1   4 use warnings;
  1         1  
  1         19  
19              
20 1     1   5 use Net::DRI::Protocol::EPP::Core::Status;
  1         1  
  1         934  
21              
22             =pod
23              
24             =head1 NAME
25              
26             Net::DRI::Protocol::Whois::Domain::common - Whois commands (RFC3912) for Net::DRI
27              
28             =head1 DESCRIPTION
29              
30             Please see the README file for details.
31              
32             =head1 SUPPORT
33              
34             For now, support questions should be sent to:
35              
36             Enetdri@dotandco.comE
37              
38             Please also see the SUPPORT file in the distribution.
39              
40             =head1 SEE ALSO
41              
42             Ehttp://www.dotandco.com/services/software/Net-DRI/E
43              
44             =head1 AUTHOR
45              
46             Patrick Mevzek, Enetdri@dotandco.comE
47              
48             =head1 COPYRIGHT
49              
50             Copyright (c) 2007-2009,2012-2013 Patrick Mevzek .
51             All rights reserved.
52              
53             This program is free software; you can redistribute it and/or modify
54             it under the terms of the GNU General Public License as published by
55             the Free Software Foundation; either version 2 of the License, or
56             (at your option) any later version.
57              
58             See the LICENSE file that comes with this distribution for more details.
59              
60             =cut
61              
62             ####################################################################################################
63              
64             sub epp_parse_registrars
65             {
66 0     0 0   my ($po,$domain,$rr,$rinfo)=@_;
67 0           my %t=('Sponsoring Registrar' => 'cl',
68             'Created By' => 'cr',
69             'Created by Registrar' => 'cr',
70             'Updated By' => 'up',
71             'Last Updated by Registrar' => 'up',
72             );
73              
74 0           while(my ($whois,$epp)=each(%t))
75             {
76 0 0         next unless exists($rr->{$whois});
77 0           my $s=$rr->{$whois}->[0];
78 0 0         if ($s=~m/^\s*(\S.+\S)\s+\((\S+)\)\s*$/)
79             {
80 0           $rinfo->{domain}->{$domain}->{$epp.'ID'}=$2;
81 0           $rinfo->{domain}->{$domain}->{$epp.'Name'}=$1;
82             } else
83             {
84 0           $rinfo->{domain}->{$domain}->{$epp.'ID'}=$s;
85             }
86             }
87 0           return;
88             }
89              
90             sub epp_parse_dates
91             {
92 0     0 0   my ($po,$domain,$rr,$rinfo)=@_;
93 0           my $strp=$po->build_strptime_parser(pattern => '%d-%b-%Y %T UTC', locale => 'en_US', time_zone => 'UTC');
94 0           $rinfo->{domain}->{$domain}->{crDate}=$strp->parse_datetime($rr->{'Created On'}->[0]);
95              
96 0           foreach my $k ('Updated On','Last Updated On')
97             {
98 0 0         next unless exists($rr->{$k});
99 0           $rinfo->{domain}->{$domain}->{upDate}=$strp->parse_datetime($rr->{$k}->[0]);
100 0           last;
101             }
102 0           foreach my $k ('Expires On','Expiration Date')
103             {
104 0 0         next unless exists($rr->{$k});
105 0           $rinfo->{domain}->{$domain}->{exDate}=$strp->parse_datetime($rr->{$k}->[0]);
106 0           last;
107             }
108 0           return;
109             }
110              
111             sub epp_parse_status
112             {
113 0     0 0   my ($po,$domain,$rr,$rinfo)=@_;
114 0           my @s;
115 0 0         if (exists($rr->{'Domain Status'}))
    0          
116             {
117 0           @s=map { my $s=$_; $s=~s/OK/ok/; $s; } @{$rr->{'Domain Status'}};
  0            
  0            
  0            
  0            
118             } elsif (exists($rr->{'Status'})) ## .ORG/.INFO/.MOBI/.CAT variation
119             {
120 0           @s=map { my $t=lc($_); $t=~s/ (.)/uc($1)/eg; $t; } @{$rr->{'Status'}};
  0            
  0            
  0            
  0            
  0            
121             }
122 0 0         $rinfo->{domain}->{$domain}->{status}=Net::DRI::Protocol::EPP::Core::Status->new(\@s) if @s;
123 0           return;
124             }
125              
126             sub epp_parse_contacts
127             {
128 0     0 0   my ($po,$domain,$rr,$rinfo,$rh)=@_;
129 0           my $cs=$po->create_local_object('contactset');
130 0           while(my ($type,$whois)=each %$rh)
131             {
132 0           my $c=$po->create_local_object('contact');
133 0 0 0       $c->srid($rr->{$whois.' ID'}->[0]) if (exists $rr->{$whois.' ID'} && length $rr->{$whois.' ID'}->[0]);
134 0 0 0       $c->name($rr->{$whois.' Name'}->[0]) if (exists $rr->{$whois.' Name'} && length $rr->{$whois.' Name'}->[0]);
135 0 0 0       $c->org($rr->{$whois.' Organization'}->[0]) if (exists $rr->{$whois.' Organization'} && length $rr->{$whois.' Organization'}->[0]);
136 0           my @s;
137 0           foreach my $st (qw/Street Address/) ## 2nd form needed for .BIZ
138             {
139 0           my $k=$whois.' '.$st;
140 0 0         @s=map { $rr->{$k.$_}->[0] } grep { exists $rr->{$k.$_} && length $rr->{$k.$_}->[0] } (1..3);
  0            
  0            
141 0 0         next unless @s;
142 0           $c->street(\@s);
143 0           last;
144             }
145 0 0 0       $c->city($rr->{$whois.' City'}->[0]) if (exists $rr->{$whois.' City'} && length $rr->{$whois.' City'}->[0]);
146 0 0 0       $c->sp($rr->{$whois.' State/Province'}->[0]) if (exists $rr->{$whois.' State/Province'} && length $rr->{$whois.' State/Province'}->[0]);
147 0 0 0       $c->pc($rr->{$whois.' Postal Code'}->[0]) if (exists $rr->{$whois.' Postal Code'} && length $rr->{$whois.' Postal Code'}->[0]);
148 0 0 0       $c->cc($rr->{$whois.' Country'}->[0]) if (exists $rr->{$whois.' Country'} && length $rr->{$whois.' Country'}->[0]);
149 0           my $t;
150 0           foreach my $st ('Phone','Phone Number') ## 2nd form needed for .BIZ
151             {
152 0           $t=epp_parse_tel($po,$rr,$whois.' '.$st);
153 0 0         next unless $t;
154 0           $c->voice($t);
155 0           last;
156             }
157 0           foreach my $st ('FAX','Facsimile Number') ## 2nd form needed for .BIZ
158             {
159 0           $t=epp_parse_tel($po,$rr,$whois.' '.$st);
160 0 0         next unless $t;
161 0           $c->fax($t);
162 0           last;
163             }
164 0 0 0       $c->email($rr->{$whois.' Email'}->[0]) if (exists $rr->{$whois.' Email'} && length $rr->{$whois.' Email'}->[0]);
165 0 0         $cs->add($c,$type) if grep { length } ($c->srid(),$c->name(),$c->city(),$c->cc(),$c->email());
  0            
166             }
167 0           $rinfo->{domain}->{$domain}->{contact}=$cs;
168 0           return;
169             }
170              
171             sub epp_parse_tel
172             {
173 0     0 0   my ($po,$rr,$key)=@_;
174 0 0 0       return '' unless (exists($rr->{$key}) && $rr->{$key}->[0]);
175 0           my $r=$rr->{$key}->[0];
176 0 0 0       $r.='x'.$rr->{$key.' Ext.'}->[0] if (exists($rr->{$key.' Ext.'}) && $rr->{$key.' Ext.'}->[0]);
177 0           return $r;
178             }
179              
180             sub epp_parse_ns
181             {
182 0     0 0   my ($po,$domain,$rr,$rinfo)=@_;
183 0 0         return unless (exists($rr->{'Name Server'}));
184 0 0         my @ns=grep { defined($_) && $_ } @{$rr->{'Name Server'}};
  0            
  0            
185 0 0         $rinfo->{domain}->{$domain}->{ns}=$po->create_local_object('hosts')->set(@ns) if @ns;
186 0           return;
187             }
188              
189             ####################################################################################################
190             1;