File Coverage

blib/lib/Net/DRI/Protocol/Whois/Domain/LU.pm
Criterion Covered Total %
statement 18 101 17.8
branch 0 34 0.0
condition 0 21 0.0
subroutine 6 15 40.0
pod 0 9 0.0
total 24 180 13.3


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Whois commands for .LU (RFC3912)
2             ##
3             ## Copyright (c) 2008,2009,2013,2014 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::LU;
16              
17 1     1   699 use strict;
  1         2  
  1         28  
18 1     1   4 use warnings;
  1         2  
  1         19  
19              
20 1     1   5 use Carp;
  1         1  
  1         69  
21 1     1   4 use Net::DRI::Exception;
  1         2  
  1         19  
22 1     1   4 use Net::DRI::Util;
  1         1  
  1         17  
23 1     1   5 use Net::DRI::Protocol::EPP::Core::Status;
  1         2  
  1         955  
24              
25             =pod
26              
27             =head1 NAME
28              
29             Net::DRI::Protocol::Whois::Domain::LU - .LU Whois commands (RFC3912) for Net::DRI
30              
31             =head1 DESCRIPTION
32              
33             Please see the README file for details.
34              
35             =head1 SUPPORT
36              
37             For now, support questions should be sent to:
38              
39             Enetdri@dotandco.comE
40              
41             Please also see the SUPPORT file in the distribution.
42              
43             =head1 SEE ALSO
44              
45             Ehttp://www.dotandco.com/services/software/Net-DRI/E
46              
47             =head1 AUTHOR
48              
49             Patrick Mevzek, Enetdri@dotandco.comE
50              
51             =head1 COPYRIGHT
52              
53             Copyright (c) 2008,2009,2013,2014 Patrick Mevzek .
54             All rights reserved.
55              
56             This program is free software; you can redistribute it and/or modify
57             it under the terms of the GNU General Public License as published by
58             the Free Software Foundation; either version 2 of the License, or
59             (at your option) any later version.
60              
61             See the LICENSE file that comes with this distribution for more details.
62              
63             =cut
64              
65             ####################################################################################################
66              
67             sub register_commands
68             {
69 0     0 0   my ($class,$version)=@_;
70 0           return { 'domain' => { info => [ \&info, \&info_parse ] } };
71             }
72              
73             sub info
74             {
75 0     0 0   my ($po,$domain,$rd)=@_;
76 0           my $mes=$po->message();
77 0 0         Net::DRI::Exception->die(1,'protocol/whois',10,'Invalid domain name: '.$domain) unless Net::DRI::Util::is_hostname($domain);
78 0           $mes->command(lc $domain);
79 0           return;
80             }
81              
82             sub info_parse
83             {
84 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
85 0           my $mes=$po->message();
86 0 0         return unless $mes->is_success();
87              
88 0           my $rr=$mes->response();
89 0           my $rd=$mes->response_raw();
90 0           my ($domain,$exist)=parse_domain($po,$rr,$rd,$rinfo);
91 0 0         $domain=lc($oname) unless defined($domain);
92 0           $rinfo->{domain}->{$domain}->{exist}=$exist;
93 0           $rinfo->{domain}->{$domain}->{action}='info';
94              
95 0 0         return unless $exist;
96              
97 0           parse_status($po,$domain,$rr,$rinfo);
98 0           parse_ns($po,$domain,$rr,$rinfo);
99 0           parse_dates($po,$domain,$rr,$rinfo);
100 0           parse_contacts($po,$domain,$rr,$rinfo);
101 0           parse_registrars($po,$domain,$rr,$rinfo);
102 0           return;
103             }
104              
105             sub parse_domain
106             {
107 0     0 0   my ($po,$rr,$rd,$rinfo)=@_;
108 0           my ($dom,$e);
109 0 0         if ($rd=~m/\n% WHOIS (\S+)\n% No such domain$/s)
110             {
111 0           $dom=$1.'.lu';
112 0           $e=0;
113             } else
114             {
115 0           $e=1;
116 0           $dom=lc($rr->{'domainname'}->[0]);
117             }
118 0           return ($dom,$e);
119             }
120              
121             sub parse_status
122             {
123 0     0 0   my ($po,$domain,$rr,$rinfo)=@_;
124 0           my @s=map { my $s=$_; $s=~s/ACTIVE/ok/; $s; } @{$rr->{'domaintype'}};
  0            
  0            
  0            
  0            
125 0 0         carp('For '.$domain.' new status found, please report: '.join(' ',@s)) if (grep { $_ ne 'ok' } @s);
  0            
126 0 0         $rinfo->{domain}->{$domain}->{status}=Net::DRI::Protocol::EPP::Core::Status->new(\@s) if @s;
127 0           return;
128             }
129              
130             sub parse_ns
131             {
132 0     0 0   my ($po,$domain,$rr,$rinfo)=@_;
133 0           my $h=$po->create_local_object('hosts');
134 0 0         foreach my $ns (grep { defined($_) && $_ } @{$rr->{'nserver'}})
  0            
  0            
135             {
136 0 0         if (my ($name,$ips)=($ns=~m/^(\S+) \[(\S+)\]$/))
137             {
138 0           my @ips=split(/,/,$ips);
139 0           $h->add($name,\@ips);
140             } else
141             {
142 0           $h->add($ns);
143             }
144             }
145 0 0         $rinfo->{domain}->{$domain}->{ns}=$h unless $h->is_empty();
146 0           return;
147             }
148              
149             sub parse_dates
150             {
151 0     0 0   my ($po,$domain,$rr,$rinfo)=@_;
152 0           my $strp=$po->build_strptime_parser(pattern => '%d/%m/%Y', time_zone => 'Europe/Luxembourg');
153 0           $rinfo->{domain}->{$domain}->{crDate}=$strp->parse_datetime($rr->{'registered'}->[0]);
154 0           return;
155             }
156              
157             sub parse_contacts
158             {
159 0     0 0   my ($po,$domain,$rr,$rinfo)=@_;
160 0           my $cs=$po->create_local_object('contactset');
161 0           my %t=('org' => 'registrant', 'adm' => 'admin', 'tec' => 'tech');
162 0           foreach my $t (sort { $a cmp $b } keys %t)
  0            
163             {
164 0           my $c=$po->create_local_object('contact');
165 0           $c->type('contact');
166 0 0 0       $c->name($rr->{$t.'-name'}->[0]) if (exists($rr->{$t.'-name'}) && $rr->{$t.'-name'}->[0]);
167 0 0 0       $c->street($rr->{$t.'-address'}) if (exists($rr->{$t.'-address'}) && @{$rr->{$t.'-address'}});
  0            
168 0 0 0       $c->pc($rr->{$t.'-zipcode'}->[0]) if (exists($rr->{$t.'-zipcode'}) && $rr->{$t.'-zipcode'}->[0]);
169 0 0 0       $c->city($rr->{$t.'-city'}->[0]) if (exists($rr->{$t.'-city'}) && $rr->{$t.'-city'}->[0]);
170 0 0 0       $c->cc($rr->{$t.'-country'}->[0]) if (exists($rr->{$t.'-country'}) && $rr->{$t.'-country'}->[0]);
171 0 0 0       $c->email($rr->{$t.'-email'}->[0]) if (exists($rr->{$t.'-email'}) && $rr->{$t.'-email'}->[0]);
172 0           $cs->add($c,$t{$t});
173             }
174              
175 0           my %ot=('ORGANISATION' => 'holder_org', 'PRIVATE' => 'holder_pers');
176 0           my $type=$rr->{'ownertype'}->[0];
177 0 0 0       carp('For '.$domain.' new ownertype found, please report: '.$type) if ($type ne 'ORGANISATION' && $type ne 'PRIVATE');
178 0           $cs->get('registrant')->type($ot{$type});
179              
180 0           $rinfo->{domain}->{$domain}->{contact}=$cs;
181 0           return;
182             }
183              
184             sub parse_registrars
185             {
186 0     0 0   my ($po,$domain,$rr,$rinfo)=@_;
187 0           $rinfo->{domain}->{$domain}->{clName}=$rr->{'registrar-name'}->[0];
188 0           $rinfo->{domain}->{$domain}->{clEmail}=$rr->{'registrar-email'}->[0];
189 0           $rinfo->{domain}->{$domain}->{clWebsite}=$rr->{'registrar-url'}->[0];
190 0           $rinfo->{domain}->{$domain}->{clCountry}=$rr->{'registrar-country'}->[0];
191 0           return;
192             }
193              
194             ####################################################################################################
195             1;