line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Whois::Parser; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
156993
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
7
|
use utf8; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
9
|
|
6
|
1
|
|
|
1
|
|
29
|
use Net::Whois::Raw; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
6
|
|
7
|
1
|
|
|
1
|
|
1242
|
use Data::Dumper; |
|
1
|
|
|
|
|
11062
|
|
|
1
|
|
|
|
|
344
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.07'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our @EXPORT = qw( parse_whois ); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $DEBUG = 0; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# parsers for parse whois text to data structure |
16
|
|
|
|
|
|
|
our %PARSERS = ( |
17
|
|
|
|
|
|
|
'DEFAULT' => \&_default_parser, |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# rules to convert diferent names of same fields to standard name |
21
|
|
|
|
|
|
|
our %FIELD_NAME_CONV = ( |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# nameservers |
24
|
|
|
|
|
|
|
nserver => 'nameservers', |
25
|
|
|
|
|
|
|
name_server => 'nameservers', |
26
|
|
|
|
|
|
|
name_serever => 'nameservers', |
27
|
|
|
|
|
|
|
name_server => 'nameservers', |
28
|
|
|
|
|
|
|
nameserver => 'nameservers', |
29
|
|
|
|
|
|
|
dns1 => 'nameservers', |
30
|
|
|
|
|
|
|
dns2 => 'nameservers', |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# domain |
33
|
|
|
|
|
|
|
domain_name => 'domain', |
34
|
|
|
|
|
|
|
domainname => 'domain', |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# creation_date |
37
|
|
|
|
|
|
|
created => 'creation_date', |
38
|
|
|
|
|
|
|
created_on => 'creation_date', |
39
|
|
|
|
|
|
|
creation_date => 'creation_date', |
40
|
|
|
|
|
|
|
domain_registration_date => 'creation_date', |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
#expiration_date |
43
|
|
|
|
|
|
|
expire => 'expiration_date', |
44
|
|
|
|
|
|
|
expire_date => 'expiration_date', |
45
|
|
|
|
|
|
|
expires => 'expiration_date', |
46
|
|
|
|
|
|
|
expires_at => 'expiration_date', |
47
|
|
|
|
|
|
|
expires_on => 'expiration_date', |
48
|
|
|
|
|
|
|
expiry_date => 'expiration_date', |
49
|
|
|
|
|
|
|
domain_expiration_date => 'expiration_date', |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# You can turn this flag to get |
54
|
|
|
|
|
|
|
# all values of field in all whois answers |
55
|
|
|
|
|
|
|
our $GET_ALL_VALUES = 0; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# hooks for formating values |
58
|
|
|
|
|
|
|
our %HOOKS = ( |
59
|
|
|
|
|
|
|
nameservers => [ \&format_nameservers ], |
60
|
|
|
|
|
|
|
emails => [ sub {my $value = shift; ref $value ? $value : [$value] } ], |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# From Net::Whois::Raw |
64
|
|
|
|
|
|
|
sub import { |
65
|
1
|
|
|
1
|
|
14
|
my $mypkg = shift; |
66
|
1
|
|
|
|
|
4
|
my $callpkg = caller; |
67
|
|
|
|
|
|
|
|
68
|
1
|
|
|
1
|
|
11
|
no strict 'refs'; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
2775
|
|
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# export subs |
71
|
1
|
|
|
|
|
4
|
*{"$callpkg\::$_"} = \&{"$mypkg\::$_"} foreach ((@EXPORT, @_)); |
|
1
|
|
|
|
|
2652
|
|
|
1
|
|
|
|
|
7
|
|
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# fetches whois text |
75
|
|
|
|
|
|
|
sub _fetch_whois { |
76
|
2
|
|
|
2
|
|
5
|
my %args = @_; |
77
|
|
|
|
|
|
|
|
78
|
2
|
|
|
|
|
7
|
local $Net::Whois::Raw::CHECK_FAIL = 1; |
79
|
|
|
|
|
|
|
|
80
|
2
|
|
|
|
|
4
|
my @res = eval { |
81
|
2
|
|
50
|
|
|
37
|
Net::Whois::Raw::whois( |
|
|
|
50
|
|
|
|
|
82
|
|
|
|
|
|
|
$args{domain}, |
83
|
|
|
|
|
|
|
$args{server} || undef, |
84
|
|
|
|
|
|
|
$args{which_whois} || 'QRY_ALL' |
85
|
|
|
|
|
|
|
) |
86
|
|
|
|
|
|
|
}; |
87
|
2
|
50
|
|
|
|
656270
|
return undef if $@; |
88
|
|
|
|
|
|
|
|
89
|
2
|
50
|
|
|
|
11
|
my $res = ref $res[0] ? $res[0] : [ { text => $res[0], srv => $res[1] } ]; |
90
|
2
|
|
|
|
|
9
|
@$res = grep { $_->{text} } @$res; |
|
2
|
|
|
|
|
13
|
|
91
|
|
|
|
|
|
|
|
92
|
2
|
100
|
|
|
|
13
|
return scalar @$res ? $res : undef; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub parse_whois { |
96
|
|
|
|
|
|
|
#TODO warn: Odd number of elements in hash assignment |
97
|
7
|
|
|
7
|
1
|
501919
|
my %args = @_; |
98
|
|
|
|
|
|
|
|
99
|
7
|
100
|
|
|
|
36
|
if ( $args{raw} ) { |
|
|
50
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
101
|
5
|
|
50
|
|
|
32
|
my $server = |
102
|
|
|
|
|
|
|
$args{server} || |
103
|
|
|
|
|
|
|
Net::Whois::Raw::Common::get_server($args{domain}) || |
104
|
|
|
|
|
|
|
'DEFAULT'; |
105
|
|
|
|
|
|
|
|
106
|
5
|
100
|
|
|
|
61957
|
my $whois = ref $args{raw} ? $args{raw} : [ { text => $args{raw}, srv => $server } ]; |
107
|
|
|
|
|
|
|
|
108
|
5
|
|
|
|
|
19
|
return _process_parse($whois); |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
elsif ( $args{domain} ) { |
112
|
2
|
|
|
|
|
10
|
my $whois = _fetch_whois(%args); |
113
|
2
|
100
|
|
|
|
23
|
return $whois ? _process_parse($whois) : undef; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
0
|
undef; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _process_parse { |
120
|
6
|
|
|
6
|
|
13
|
my ( $whois ) = @_; |
121
|
|
|
|
|
|
|
|
122
|
6
|
|
|
|
|
13
|
my @data = (); |
123
|
6
|
|
|
|
|
16
|
for my $ans ( @$whois ) { |
124
|
|
|
|
|
|
|
|
125
|
8
|
50
|
66
|
|
|
69
|
my $parser = |
126
|
|
|
|
|
|
|
$ans->{srv} && $PARSERS{$ans->{srv}} ? |
127
|
|
|
|
|
|
|
$PARSERS{$ans->{srv}} : $PARSERS{DEFAULT}; |
128
|
|
|
|
|
|
|
|
129
|
8
|
|
|
|
|
30
|
push @data, $parser->($ans->{text}); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
6
|
|
|
|
|
29
|
_post_parse(\@data); |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# standardize data structure |
136
|
|
|
|
|
|
|
sub _post_parse { |
137
|
6
|
|
|
6
|
|
14
|
my ( $data ) = @_; |
138
|
|
|
|
|
|
|
|
139
|
6
|
|
|
|
|
14
|
my %res = (); |
140
|
6
|
|
|
|
|
12
|
my $count = 0; |
141
|
6
|
|
|
|
|
14
|
my %flag = (); |
142
|
|
|
|
|
|
|
|
143
|
6
|
|
|
|
|
2169
|
for my $hash ( @$data ) { |
144
|
|
|
|
|
|
|
|
145
|
8
|
|
|
|
|
8
|
$count++; |
146
|
|
|
|
|
|
|
|
147
|
8
|
|
|
|
|
47
|
for my $key ( keys %$hash ) { |
148
|
54
|
50
|
|
|
|
129
|
next unless $hash->{$key}; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# change keys to standard names |
151
|
54
|
|
|
|
|
89
|
my $new_key = lc $key; |
152
|
54
|
|
|
|
|
256
|
$new_key =~ s/\s+|\t+|-/_/g; |
153
|
54
|
100
|
|
|
|
344
|
if ( exists $FIELD_NAME_CONV{$new_key} ) { |
154
|
8
|
|
|
|
|
19
|
$new_key = $FIELD_NAME_CONV{$new_key}; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
54
|
100
|
|
|
|
109
|
unless ( $GET_ALL_VALUES ) { |
158
|
48
|
50
|
33
|
|
|
173
|
if ( exists $res{$new_key} && !$flag{$new_key} ) { |
159
|
0
|
|
|
|
|
0
|
delete $res{$new_key}; |
160
|
0
|
|
|
|
|
0
|
$flag{$new_key} = 1; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# add values to result hash |
165
|
54
|
100
|
|
|
|
94
|
if ( exists $res{$new_key} ) { |
166
|
4
|
|
|
|
|
6
|
push @{$res{$new_key}}, @{$hash->{$key}}; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
14
|
|
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
else { |
169
|
50
|
50
|
|
|
|
208
|
$res{$new_key} = ref $hash->{$key} ? $hash->{$key} : [$hash->{$key}]; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# make unique and process hooks |
176
|
6
|
|
|
|
|
32
|
while ( my ( $key, $value ) = each %res ) { |
177
|
|
|
|
|
|
|
|
178
|
50
|
100
|
|
|
|
89
|
if ( scalar @$value > 1 ) { |
179
|
5
|
|
|
|
|
18
|
@$value = _make_unique(@$value); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
else { |
182
|
45
|
|
|
|
|
75
|
$value = $value->[0]; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
50
|
100
|
|
|
|
154
|
if ( exists $HOOKS{$key} ) { |
186
|
10
|
|
|
|
|
13
|
for my $hook ( @{$HOOKS{$key}} ) { $value = $hook->($value) } |
|
10
|
|
|
|
|
25
|
|
|
10
|
|
|
|
|
31
|
|
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
50
|
|
|
|
|
181
|
$res{$key} = $value; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
6
|
|
|
|
|
83
|
\%res; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub _make_unique { |
197
|
5
|
|
|
5
|
|
8
|
my %vals; |
198
|
5
|
|
|
|
|
12
|
grep { not $vals{$_} ++ } @_; |
|
11
|
|
|
|
|
67
|
|
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
## PARSERS ## |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# Regular expression built using Jeffrey Friedl's example in |
204
|
|
|
|
|
|
|
# _Mastering Regular Expressions_ (http://www.ora.com/catalog/regexp/). |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
my $RFC822PAT = <<'EOF'; |
207
|
|
|
|
|
|
|
[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\ |
208
|
|
|
|
|
|
|
xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xf |
209
|
|
|
|
|
|
|
f\n\015()]*)*\)[\040\t]*)*(?:(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\x |
210
|
|
|
|
|
|
|
ff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015 |
211
|
|
|
|
|
|
|
"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\ |
212
|
|
|
|
|
|
|
xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80 |
213
|
|
|
|
|
|
|
-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]* |
214
|
|
|
|
|
|
|
)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\ |
215
|
|
|
|
|
|
|
\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\ |
216
|
|
|
|
|
|
|
x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x8 |
217
|
|
|
|
|
|
|
0-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n |
218
|
|
|
|
|
|
|
\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x |
219
|
|
|
|
|
|
|
80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^ |
220
|
|
|
|
|
|
|
\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040 |
221
|
|
|
|
|
|
|
\t]*)*)*@[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([ |
222
|
|
|
|
|
|
|
^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\ |
223
|
|
|
|
|
|
|
\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\ |
224
|
|
|
|
|
|
|
x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80- |
225
|
|
|
|
|
|
|
\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015() |
226
|
|
|
|
|
|
|
]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\ |
227
|
|
|
|
|
|
|
x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\04 |
228
|
|
|
|
|
|
|
0\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\ |
229
|
|
|
|
|
|
|
n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\ |
230
|
|
|
|
|
|
|
015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?! |
231
|
|
|
|
|
|
|
[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\ |
232
|
|
|
|
|
|
|
]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\ |
233
|
|
|
|
|
|
|
x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\01 |
234
|
|
|
|
|
|
|
5()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*|(?:[^(\040)<>@,;:". |
235
|
|
|
|
|
|
|
\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff] |
236
|
|
|
|
|
|
|
)|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^ |
237
|
|
|
|
|
|
|
()<>@,;:".\\\[\]\x80-\xff\000-\010\012-\037]*(?:(?:\([^\\\x80-\xff\n\0 |
238
|
|
|
|
|
|
|
15()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][ |
239
|
|
|
|
|
|
|
^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)|"[^\\\x80-\xff\ |
240
|
|
|
|
|
|
|
n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^()<>@,;:".\\\[\]\ |
241
|
|
|
|
|
|
|
x80-\xff\000-\010\012-\037]*)*<[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(? |
242
|
|
|
|
|
|
|
:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80- |
243
|
|
|
|
|
|
|
\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:@[\040\t]* |
244
|
|
|
|
|
|
|
(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015 |
245
|
|
|
|
|
|
|
()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015() |
246
|
|
|
|
|
|
|
]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\0 |
247
|
|
|
|
|
|
|
40)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\ |
248
|
|
|
|
|
|
|
[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\ |
249
|
|
|
|
|
|
|
xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]* |
250
|
|
|
|
|
|
|
)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80 |
251
|
|
|
|
|
|
|
-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x |
252
|
|
|
|
|
|
|
80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t |
253
|
|
|
|
|
|
|
]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\ |
254
|
|
|
|
|
|
|
\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff]) |
255
|
|
|
|
|
|
|
*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x |
256
|
|
|
|
|
|
|
80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80 |
257
|
|
|
|
|
|
|
-\xff\n\015()]*)*\)[\040\t]*)*)*(?:,[\040\t]*(?:\([^\\\x80-\xff\n\015( |
258
|
|
|
|
|
|
|
)]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\ |
259
|
|
|
|
|
|
|
\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*@[\040\t |
260
|
|
|
|
|
|
|
]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\0 |
261
|
|
|
|
|
|
|
15()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015 |
262
|
|
|
|
|
|
|
()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^( |
263
|
|
|
|
|
|
|
\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]| |
264
|
|
|
|
|
|
|
\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80 |
265
|
|
|
|
|
|
|
-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015() |
266
|
|
|
|
|
|
|
]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x |
267
|
|
|
|
|
|
|
80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^ |
268
|
|
|
|
|
|
|
\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040 |
269
|
|
|
|
|
|
|
\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:". |
270
|
|
|
|
|
|
|
\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff |
271
|
|
|
|
|
|
|
])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\ |
272
|
|
|
|
|
|
|
\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x |
273
|
|
|
|
|
|
|
80-\xff\n\015()]*)*\)[\040\t]*)*)*)*:[\040\t]*(?:\([^\\\x80-\xff\n\015 |
274
|
|
|
|
|
|
|
()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\ |
275
|
|
|
|
|
|
|
\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)?(?:[^ |
276
|
|
|
|
|
|
|
(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000- |
277
|
|
|
|
|
|
|
\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\ |
278
|
|
|
|
|
|
|
n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]| |
279
|
|
|
|
|
|
|
\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\)) |
280
|
|
|
|
|
|
|
[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff |
281
|
|
|
|
|
|
|
\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\x |
282
|
|
|
|
|
|
|
ff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*( |
283
|
|
|
|
|
|
|
?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\ |
284
|
|
|
|
|
|
|
000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\ |
285
|
|
|
|
|
|
|
xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\x |
286
|
|
|
|
|
|
|
ff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*) |
287
|
|
|
|
|
|
|
*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*@[\040\t]*(?:\([^\\\x80-\x |
288
|
|
|
|
|
|
|
ff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80- |
289
|
|
|
|
|
|
|
\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*) |
290
|
|
|
|
|
|
|
*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\ |
291
|
|
|
|
|
|
|
]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\] |
292
|
|
|
|
|
|
|
)[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80- |
293
|
|
|
|
|
|
|
\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\x |
294
|
|
|
|
|
|
|
ff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*( |
295
|
|
|
|
|
|
|
?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80 |
296
|
|
|
|
|
|
|
-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)< |
297
|
|
|
|
|
|
|
>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x8 |
298
|
|
|
|
|
|
|
0-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?: |
299
|
|
|
|
|
|
|
\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()] |
300
|
|
|
|
|
|
|
*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*) |
301
|
|
|
|
|
|
|
*\)[\040\t]*)*)*>) |
302
|
|
|
|
|
|
|
EOF |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
$RFC822PAT =~ s/\n//g; |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub _default_parser { |
308
|
8
|
|
|
8
|
|
13
|
my ( $raw ) = @_; |
309
|
8
|
|
|
|
|
12
|
my %data; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# transform data to key => value |
312
|
8
|
|
|
|
|
55
|
for my $line ( split /\n/, $raw ) { |
313
|
|
|
|
|
|
|
|
314
|
79
|
|
|
|
|
97
|
chomp $line; |
315
|
79
|
|
|
|
|
128
|
$line =~ s/^\s+//; |
316
|
79
|
|
|
|
|
196
|
$line =~ s/\s+$//; |
317
|
|
|
|
|
|
|
|
318
|
79
|
|
|
|
|
279
|
my ( $key, $value ) = $line =~ /^\s*([\d\w\s_-]+):\s*(.+)$/; |
319
|
79
|
100
|
66
|
|
|
351
|
next if !$line || !$value; |
320
|
50
|
|
|
|
|
87
|
$key =~ s/\s+$//; |
321
|
50
|
|
|
|
|
87
|
$value =~ s/\s+$//; |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# if we have more then one value for one field we push them into array |
324
|
4
|
|
|
|
|
18
|
$data{$key} = ref $data{$key} eq 'ARRAY' ? |
325
|
50
|
100
|
|
|
|
228
|
[ @{$data{$key}}, $value ] : [ $value ]; |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# find all emails in the text |
330
|
8
|
|
|
|
|
31612
|
my @emails = $raw =~ /($RFC822PAT)/gso; |
331
|
8
|
|
|
|
|
78
|
@emails = map { $_ =~ s/\s+//g; ($_) } @emails; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
332
|
0
|
|
|
|
|
0
|
$data{emails} = exists $data{emails} ? |
333
|
8
|
50
|
|
|
|
41
|
[ @{$data{emails}}, @emails ] : \@emails; |
334
|
|
|
|
|
|
|
|
335
|
8
|
|
|
|
|
46
|
\%data; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
## FORMATERS ## |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
sub format_nameservers { |
341
|
4
|
|
|
4
|
0
|
7
|
my ( $value ) = @_; |
342
|
|
|
|
|
|
|
|
343
|
4
|
50
|
|
|
|
14
|
$value = [$value] unless ref $value; |
344
|
|
|
|
|
|
|
|
345
|
4
|
|
|
|
|
9
|
my @nss; |
346
|
4
|
|
|
|
|
10
|
for my $ns ( @$value ) { |
347
|
8
|
|
|
|
|
171
|
my ( $domain, $ip ) = split /\s+/, $ns; |
348
|
|
|
|
|
|
|
|
349
|
8
|
|
33
|
|
|
24
|
$domain ||= $ns; |
350
|
8
|
|
|
|
|
34
|
$domain =~ s/\.$//; |
351
|
8
|
|
|
|
|
16
|
$domain = lc $domain; |
352
|
|
|
|
|
|
|
|
353
|
8
|
50
|
|
|
|
46
|
push @nss, { |
354
|
|
|
|
|
|
|
domain => $domain, |
355
|
|
|
|
|
|
|
( $ip ? (ip => $ip) : () ) |
356
|
|
|
|
|
|
|
}; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
4
|
|
|
|
|
18
|
\@nss; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
1; |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=head1 NAME |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
Net::Whois::Parser - module for parsing whois information |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=head1 SYNOPSIS |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
use Net::Whois::Parser; |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
my $info = parse_whois( domain => $domain ); |
373
|
|
|
|
|
|
|
my $info = parse_whois( raw => $whois_raw_text, domain => $domain ); |
374
|
|
|
|
|
|
|
my $info = parse_whois( raw => $whois_raw_text, server => $whois_server ); |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
$info = { |
377
|
|
|
|
|
|
|
nameservers => [ |
378
|
|
|
|
|
|
|
{ domain => 'ns.example.com', ip => '123.123.123.123' }, |
379
|
|
|
|
|
|
|
{ domain => 'ns.example.com' }, |
380
|
|
|
|
|
|
|
], |
381
|
|
|
|
|
|
|
emails => [ 'admin@example.com' ], |
382
|
|
|
|
|
|
|
domain => 'example.com', |
383
|
|
|
|
|
|
|
somefield1 => 'value', |
384
|
|
|
|
|
|
|
somefield2 => [ 'value', 'value2' ], |
385
|
|
|
|
|
|
|
... |
386
|
|
|
|
|
|
|
}; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# Your own parsers |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub my_parser { |
391
|
|
|
|
|
|
|
my ( $text ) = @_; |
392
|
|
|
|
|
|
|
return { |
393
|
|
|
|
|
|
|
nameservers => [ |
394
|
|
|
|
|
|
|
{ domain => 'ns.example.com', ip => '123.123.123.123' }, |
395
|
|
|
|
|
|
|
{ domain => 'ns.example.com' }, |
396
|
|
|
|
|
|
|
], |
397
|
|
|
|
|
|
|
emails => [ 'admin@example.com' ], |
398
|
|
|
|
|
|
|
somefield => 'value', |
399
|
|
|
|
|
|
|
somefield2 => [ 'value', 'value2' ], |
400
|
|
|
|
|
|
|
}; |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
$Net::Whois::Parser::PARSERS{'whois.example.com'} = \&my_parser; |
404
|
|
|
|
|
|
|
$Net::Whois::Parser::PARSERS{'DEFAULT'} = \&my_default_parser; |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# If you want to get all values of fields from all whois answers |
407
|
|
|
|
|
|
|
$Net::Whois::Parser::GET_ALL_VALUES = 1; |
408
|
|
|
|
|
|
|
# example |
409
|
|
|
|
|
|
|
# Net::Whois::Raw returns 2 answers |
410
|
|
|
|
|
|
|
$raw = [ { text => 'key: value1' }, { text => 'key: value2'}]; |
411
|
|
|
|
|
|
|
$data = parse_whois(raw => $raw); |
412
|
|
|
|
|
|
|
# If flag is off parser returns |
413
|
|
|
|
|
|
|
# { key => 'value2' }; |
414
|
|
|
|
|
|
|
# If flag is on parser returns |
415
|
|
|
|
|
|
|
# { key => [ 'value1', 'value2' ] }; |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
# If you want to convert some field name to another: |
418
|
|
|
|
|
|
|
$Net::Whois::Parser::FIELD_NAME_CONV{'Domain name'} = 'domain'; |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
# If you want to format some fields. |
421
|
|
|
|
|
|
|
# I think it is very useful for dates. |
422
|
|
|
|
|
|
|
$Net::Whois::Parser::HOOKS{'expiration_date'} = [ \&format_date ]; |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=head1 DESCRIPTION |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
Net::Whois::Parser module provides Whois data parsing. |
427
|
|
|
|
|
|
|
You can add your own parsers for any whois server. |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=head1 FUNCTIONS |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=over 3 |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=item parse_whois(%args) |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
Returns hash of whois data. Arguments: |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
C<'domain'> - |
438
|
|
|
|
|
|
|
domain |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
C<'raw'> - |
441
|
|
|
|
|
|
|
raw whois text |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
C<'server'> - |
444
|
|
|
|
|
|
|
whois server |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
C<'which_whois'> - |
447
|
|
|
|
|
|
|
option for Net::Whois::Raw::whois. Default value is QRY_ALL |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=back |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=head1 CHANGES |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
See file "Changes" in the distribution |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=head1 AUTHOR |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
Ivan Sokolov, C<< >> |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Copyright 2009 Ivan Sokolov |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
464
|
|
|
|
|
|
|
under the same terms as Perl itself. |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
=cut |