Net-Whois-Parser-0.08000755000765000024 012736641657 14445 5ustar00vaneskastaff000000000000Net-Whois-Parser-0.08/Build.PL000444000765000024 117412736641657 16101 0ustar00vaneskastaff000000000000use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Net::Whois::Parser', license => 'perl', dist_author => 'Ivan Sokolov ', dist_version_from => 'lib/Net/Whois/Parser.pm', build_requires => { 'Test::More' => 0, 'Net::Whois::Raw' => 2.0, }, add_to_cleanup => [ 'Net-Whois-Parser-*' ], create_makefile_pl => 'traditional', meta_merge => { resources => { repository => 'https://github.com/regru/net-whois-parser' }, } ); $builder->create_build_script(); Net-Whois-Parser-0.08/Changes000444000765000024 122012736641657 16070 0ustar00vaneskastaff0000000000000.08 2016-07-05 Fixed bug 0.07 2012-01-20 Fixed spell bug ( Jotam Jr. Trejo ) Fixed warnings in tests 0.06 2011-11-26 Fixed bug in tests 0.05 2010-02-26 Added aliases 0.04 2010-02-10 Fixed some bugs 0.03 2010-01-24 Added support formatting fields after parsing Added flag witch provide getting all values of field in all whois answers 0.02 2009-07-30 Fixed default parser to get more data fields Added some field names to convert to standard names Fixed fetch whois data to return undef if error Now parser convert fieldnames to underscore style 0.01 2009-07-15 Initial revision Net-Whois-Parser-0.08/Makefile.PL000444000765000024 60512736641657 16535 0ustar00vaneskastaff000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4211 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Net::Whois::Parser', 'VERSION_FROM' => 'lib/Net/Whois/Parser.pm', 'PREREQ_PM' => { 'Net::Whois::Raw' => 2, 'Test::More' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Net-Whois-Parser-0.08/MANIFEST000444000765000024 27712736641657 15721 0ustar00vaneskastaff000000000000Build.PL Changes lib/Net/Whois/Parser.pm MANIFEST README t/000-base.t t/001-parse-all-zones.pl examples/info.pl examples/key_count.pl examples/keys_by_whois.pl Makefile.PL META.yml META.json Net-Whois-Parser-0.08/META.json000444000765000024 176712736641657 16236 0ustar00vaneskastaff000000000000{ "abstract" : "module for parsing whois information", "author" : [ "Ivan Sokolov " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4211", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Whois-Parser", "prereqs" : { "build" : { "requires" : { "Net::Whois::Raw" : "2", "Test::More" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.42" } } }, "provides" : { "Net::Whois::Parser" : { "file" : "lib/Net/Whois/Parser.pm", "version" : "0.08" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/regru/net-whois-parser" } }, "version" : "0.08" } Net-Whois-Parser-0.08/META.yml000444000765000024 120312736641657 16047 0ustar00vaneskastaff000000000000--- abstract: 'module for parsing whois information' author: - 'Ivan Sokolov ' build_requires: Net::Whois::Raw: '2' Test::More: '0' configure_requires: Module::Build: '0.42' dynamic_config: 1 generated_by: 'Module::Build version 0.4211, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-Whois-Parser provides: Net::Whois::Parser: file: lib/Net/Whois/Parser.pm version: '0.08' resources: license: http://dev.perl.org/licenses/ repository: https://github.com/regru/net-whois-parser version: '0.08' Net-Whois-Parser-0.08/README000444000765000024 147512736641657 15471 0ustar00vaneskastaff000000000000Net-Whois-Parser INSTALLATION To install this module, run the following commands: perl Build.PL ./Build ./Build test ./Build install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Net::Whois::Parser You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Whois-Parser AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Net-Whois-Parser CPAN Ratings http://cpanratings.perl.org/d/Net-Whois-Parser Search CPAN http://search.cpan.org/dist/Net-Whois-Parser/ COPYRIGHT AND LICENCE Copyright (C) 2009 Ivan Sokolov This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-Whois-Parser-0.08/examples000755000765000024 012736641657 16263 5ustar00vaneskastaff000000000000Net-Whois-Parser-0.08/examples/info.pl000555000765000024 52112736641657 17671 0ustar00vaneskastaff000000000000#!/usr/bin/perl use strict; use utf8; use FindBin '$Bin'; use Data::Dumper; use lib "$Bin/../lib"; use Net::Whois::Parser; $Net::Whois::Raw::CHECK_FAIL = 1; $Net::Whois::Raw::TIMEOUT = 10; $Net::Whois::Parser::GET_ALL_VALUES = 1; my $info = parse_whois( domain => $ARGV[0] || 'reg.ru' ); print $info ? Dumper($info) : "failed\n"; Net-Whois-Parser-0.08/examples/key_count.pl000555000765000024 130212736641657 20754 0ustar00vaneskastaff000000000000#!/usr/bin/perl $| = 1; use strict; use utf8; use FindBin '$Bin'; use lib "$Bin/../lib"; use Net::Whois::Parser; %Net::Whois::Parser::FIELD_NAME_CONV = (); $Net::Whois::Raw::TIMEOUT = 10; my %stat = (); my $limit = 0; for my $zone ( keys %Net::Whois::Raw::Data::servers ) { $zone = lc $zone; my $domain = "www.$zone"; print "Get $domain ... "; my $info = parse_whois(domain => $domain); if ( $info ) { $stat{$_}++ for ( keys %$info ); print "done\n" } else { print "error\n"; } $limit++; last if $limit >=3; } delete $stat{emails}; print "\nKey stat:\n\n", join( "\n", map { "$_: " . $stat{$_} } sort keys %stat), "\n"; Net-Whois-Parser-0.08/examples/keys_by_whois.pl000555000765000024 171012736641657 21635 0ustar00vaneskastaff000000000000#!/usr/bin/perl $| = 1; use strict; use utf8; use FindBin '$Bin'; use lib "$Bin/../lib"; use Net::Whois::Parser; %Net::Whois::Parser::FIELD_NAME_CONV = (); $Net::Whois::Raw::TIMEOUT = 10; my %stat = (); my $limit = 0; for my $zone ( keys %Net::Whois::Raw::Data::servers ) { $zone = lc $zone; my $domain = "www.$zone"; print "Get $domain ... "; my $info = parse_whois(domain => $domain); if ( $info ) { for my $key ( keys %$info ) { $stat{$key} = {} unless exists $stat{$key}; $stat{$key}->{$zone}++; } print "done\n" } else { print "error\n"; } # $limit++; # last if $limit >=3; } delete $stat{emails}; print "\nKey stat:\n\n", join("\n\n", map {get_zones($_)} sort keys %stat), "\n"; sub get_zones { my $zones = $stat{$_[0]}; return "$_:\n" . join("\n", map { "\t$_:\t" . $zones->{$_} } sort keys %$zones); "\n"; } Net-Whois-Parser-0.08/lib000755000765000024 012736641657 15213 5ustar00vaneskastaff000000000000Net-Whois-Parser-0.08/lib/Net000755000765000024 012736641657 15741 5ustar00vaneskastaff000000000000Net-Whois-Parser-0.08/lib/Net/Whois000755000765000024 012736641657 17032 5ustar00vaneskastaff000000000000Net-Whois-Parser-0.08/lib/Net/Whois/Parser.pm000444000765000024 3622012736641657 21004 0ustar00vaneskastaff000000000000package Net::Whois::Parser; use strict; use utf8; use Net::Whois::Raw; use Data::Dumper; our $VERSION = '0.08'; our @EXPORT = qw( parse_whois ); our $DEBUG = 0; # parsers for parse whois text to data structure our %PARSERS = ( 'DEFAULT' => \&_default_parser, ); # rules to convert diferent names of same fields to standard name our %FIELD_NAME_CONV = ( # nameservers nserver => 'nameservers', name_server => 'nameservers', name_serever => 'nameservers', name_server => 'nameservers', nameserver => 'nameservers', dns1 => 'nameservers', dns2 => 'nameservers', primary_server => 'nameservers', secondary_server => 'nameservers', # domain domain_name => 'domain', domainname => 'domain', # creation_date created => 'creation_date', created_on => 'creation_date', creation_date => 'creation_date', domain_registration_date => 'creation_date', domain_created => 'creation_date', #expiration_date expire => 'expiration_date', expire_date => 'expiration_date', expires => 'expiration_date', expires_at => 'expiration_date', expires_on => 'expiration_date', expiry_date => 'expiration_date', domain_expiration_date => 'expiration_date', ); # You can turn this flag to get # all values of field in all whois answers our $GET_ALL_VALUES = 0; # hooks for formating values our %HOOKS = ( nameservers => [ \&format_nameservers ], emails => [ sub {my $value = shift; ref $value ? $value : [$value] } ], ); # From Net::Whois::Raw sub import { my $mypkg = shift; my $callpkg = caller; no strict 'refs'; # export subs *{"$callpkg\::$_"} = \&{"$mypkg\::$_"} foreach ((@EXPORT, @_)); } # fetches whois text sub _fetch_whois { my %args = @_; local $Net::Whois::Raw::CHECK_FAIL = 1; my @res = eval { Net::Whois::Raw::whois( $args{domain}, $args{server} || undef, $args{which_whois} || 'QRY_ALL' ) }; return undef if $@; my $res = ref $res[0] ? $res[0] : [ { text => $res[0], srv => $res[1] } ]; @$res = grep { $_->{text} } @$res; return scalar @$res ? $res : undef; } sub parse_whois { #TODO warn: Odd number of elements in hash assignment my %args = @_; if ( $args{raw} ) { my $server = $args{server} || Net::Whois::Raw::Common::get_server($args{domain}) || 'DEFAULT'; my $whois = ref $args{raw} ? $args{raw} : [ { text => $args{raw}, srv => $server } ]; return _process_parse($whois); } elsif ( $args{domain} ) { my $whois = _fetch_whois(%args); return $whois ? _process_parse($whois) : undef; } undef; } sub _process_parse { my ( $whois ) = @_; my @data = (); for my $ans ( @$whois ) { my $parser = $ans->{srv} && $PARSERS{$ans->{srv}} ? $PARSERS{$ans->{srv}} : $PARSERS{DEFAULT}; push @data, $parser->($ans->{text}); } _post_parse(\@data); } # standardize data structure sub _post_parse { my ( $data ) = @_; my %res = (); my $count = 0; my %flag = (); for my $hash ( @$data ) { $count++; for my $key ( keys %$hash ) { next unless $hash->{$key}; # change keys to standard names my $new_key = lc $key; $new_key =~ s/\s+|\t+|-/_/g; $new_key =~ s/\.+$//; if ( exists $FIELD_NAME_CONV{$new_key} ) { $new_key = $FIELD_NAME_CONV{$new_key}; } unless ( $GET_ALL_VALUES ) { if ( exists $res{$new_key} && !$flag{$new_key} ) { delete $res{$new_key}; $flag{$new_key} = 1; } } # add values to result hash if ( exists $res{$new_key} ) { push @{$res{$new_key}}, @{$hash->{$key}}; } else { $res{$new_key} = ref $hash->{$key} ? $hash->{$key} : [$hash->{$key}]; } } } # make unique and process hooks while ( my ( $key, $value ) = each %res ) { if ( scalar @$value > 1 ) { @$value = _make_unique(@$value); } else { $value = $value->[0]; } if ( exists $HOOKS{$key} ) { for my $hook ( @{$HOOKS{$key}} ) { $value = $hook->($value) } } $res{$key} = $value; } \%res; } sub _make_unique { my %vals; grep { not $vals{$_} ++ } @_; } ## PARSERS ## # Regular expression built using Jeffrey Friedl's example in # _Mastering Regular Expressions_ (http://www.ora.com/catalog/regexp/). my $RFC822PAT = <<'EOF'; [\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\ xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xf f\n\015()]*)*\)[\040\t]*)*(?:(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\x ff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015 "]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\ xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80 -\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]* )*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\ \\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\ x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x8 0-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n \015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x 80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^ \x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040 \t]*)*)*@[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([ ^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\ \\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\ x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80- \xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015() ]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\ x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\04 0\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\ n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\ 015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?! [^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\ ]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\ x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\01 5()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*|(?:[^(\040)<>@,;:". \\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff] )|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^ ()<>@,;:".\\\[\]\x80-\xff\000-\010\012-\037]*(?:(?:\([^\\\x80-\xff\n\0 15()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][ ^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)|"[^\\\x80-\xff\ n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^()<>@,;:".\\\[\]\ x80-\xff\000-\010\012-\037]*)*<[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(? :(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80- \xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:@[\040\t]* (?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015 ()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015() ]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\0 40)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\ [^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\ xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]* )*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80 -\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x 80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t ]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\ \[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff]) *\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x 80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80 -\xff\n\015()]*)*\)[\040\t]*)*)*(?:,[\040\t]*(?:\([^\\\x80-\xff\n\015( )]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\ \x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*@[\040\t ]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\0 15()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015 ()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^( \040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]| \\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80 -\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015() ]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x 80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^ \x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040 \t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:". \\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff ])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\ \x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x 80-\xff\n\015()]*)*\)[\040\t]*)*)*)*:[\040\t]*(?:\([^\\\x80-\xff\n\015 ()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\ \\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)?(?:[^ (\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000- \037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\ n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]| \([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\)) [^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff \n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\x ff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*( ?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\ 000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\ xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\x ff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*) *\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*@[\040\t]*(?:\([^\\\x80-\x ff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80- \xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*) *(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\ ]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\] )[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80- \xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\x ff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*( ?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80 -\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)< >@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x8 0-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?: \([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()] *(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*) *\)[\040\t]*)*)*>) EOF $RFC822PAT =~ s/\n//g; sub _default_parser { my ( $raw ) = @_; my %data; # transform data to key => value for my $line ( split /\n/, $raw ) { chomp $line; $line =~ s/^\s+//; $line =~ s/\s+$//; my ( $key, $value ) = $line =~ /^\s*([\d\w\s._-]+):\s*(.+)$/; next if !$line || !$value; $key =~ s/\s+$//; $value =~ s/\s+$//; # if we have more then one value for one field we push them into array $data{$key} = ref $data{$key} eq 'ARRAY' ? [ @{$data{$key}}, $value ] : [ $value ]; } # find all emails in the text my @emails = $raw =~ /($RFC822PAT)/gso; @emails = map { $_ =~ s/\s+//g; ($_) } @emails; $data{emails} = exists $data{emails} ? [ @{$data{emails}}, @emails ] : \@emails; \%data; } ## FORMATERS ## sub format_nameservers { my ( $value ) = @_; $value = [$value] unless ref $value; my @nss; for my $ns ( @$value ) { my ( $domain, $ip ) = split /\s+/, $ns; $domain ||= $ns; $domain =~ s/\.$//; $domain = lc $domain; push @nss, { domain => $domain, ( $ip ? (ip => $ip) : () ) }; } \@nss; } 1; =head1 NAME Net::Whois::Parser - module for parsing whois information =head1 SYNOPSIS use Net::Whois::Parser; my $info = parse_whois( domain => $domain ); my $info = parse_whois( raw => $whois_raw_text, domain => $domain ); my $info = parse_whois( raw => $whois_raw_text, server => $whois_server ); $info = { nameservers => [ { domain => 'ns.example.com', ip => '123.123.123.123' }, { domain => 'ns.example.com' }, ], emails => [ 'admin@example.com' ], domain => 'example.com', somefield1 => 'value', somefield2 => [ 'value', 'value2' ], ... }; # Your own parsers sub my_parser { my ( $text ) = @_; return { nameservers => [ { domain => 'ns.example.com', ip => '123.123.123.123' }, { domain => 'ns.example.com' }, ], emails => [ 'admin@example.com' ], somefield => 'value', somefield2 => [ 'value', 'value2' ], }; } $Net::Whois::Parser::PARSERS{'whois.example.com'} = \&my_parser; $Net::Whois::Parser::PARSERS{'DEFAULT'} = \&my_default_parser; # If you want to get all values of fields from all whois answers $Net::Whois::Parser::GET_ALL_VALUES = 1; # example # Net::Whois::Raw returns 2 answers $raw = [ { text => 'key: value1' }, { text => 'key: value2'}]; $data = parse_whois(raw => $raw); # If flag is off parser returns # { key => 'value2' }; # If flag is on parser returns # { key => [ 'value1', 'value2' ] }; # If you want to convert some field name to another: $Net::Whois::Parser::FIELD_NAME_CONV{'Domain name'} = 'domain'; # If you want to format some fields. # I think it is very useful for dates. $Net::Whois::Parser::HOOKS{'expiration_date'} = [ \&format_date ]; =head1 DESCRIPTION Net::Whois::Parser module provides Whois data parsing. You can add your own parsers for any whois server. =head1 FUNCTIONS =over 3 =item parse_whois(%args) Returns hash of whois data. Arguments: C<'domain'> - domain C<'raw'> - raw whois text C<'server'> - whois server C<'which_whois'> - option for Net::Whois::Raw::whois. Default value is QRY_ALL =back =head1 CHANGES See file "Changes" in the distribution =head1 AUTHOR Ivan Sokolov, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2009 Ivan Sokolov This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-Whois-Parser-0.08/t000755000765000024 012736641657 14710 5ustar00vaneskastaff000000000000Net-Whois-Parser-0.08/t/000-base.t000444000765000024 261412736641657 16444 0ustar00vaneskastaff000000000000#!/usr/bin/perl use strict; use Test::More; use lib qw( lib ../lib ); use Net::Whois::Raw; use Net::Whois::Parser; $Net::Whois::Parser::DEBUG = 2; my $domain = 'reg.ru'; my $info; plan tests => 12; my ( $raw, $server ) = whois($domain); ok parse_whois(raw => $raw, server => $server), "parse_whois $domain, $server"; ok parse_whois(raw => $raw, domain => $domain), "parse_whois $domain, $server"; ok parse_whois(domain => $domain), "parse_whois $domain, $server"; ok !parse_whois(domain => 'iweufhweufhweufh.ru'), 'domain not exists'; $info = parse_whois(raw => $raw, server => $server); is $info->{nameservers}->[0]->{domain}, 'ns1.reg.ru', 'reg.ru ns 1'; is $info->{nameservers}->[1]->{domain}, 'ns2.reg.ru', 'reg.ru ns 2'; is $info->{domain}, 'REG.RU', 'reg.ru domain'; $raw = " Test 1: test Test-2:wefwef wef test3: value:value test4.....: value "; $info = parse_whois( raw => $raw, server => 'whois.ripn.net' ); ok exists $info->{'test_1'}, 'field name with spaces'; ok exists $info->{'test_2'}, 'field with -'; is $info->{'test3'}, 'value:value', 'field value with :'; is $info->{'test4'}, 'value', 'field value with :'; #### $Net::Whois::Parser::GET_ALL_VALUES = 1; $raw = [ { text => "test: 1" }, { text => "tEst: 2" }, { text => "test: 3" }, ]; $info = parse_whois( raw => $raw, server => 'whois.ripn.net' ); is_deeply $info->{test}, [ 1, 2, 3], 'get_all_values is on'; Net-Whois-Parser-0.08/t/001-parse-all-zones.pl000444000765000024 112212736641657 20710 0ustar00vaneskastaff000000000000#!/usr/bin/perl use strict; use Getopt::Long; use Test::More; use lib qw( lib ../lib ); use Net::Whois::Parser; plan skip_all => 'Very long test!'; # Проверяем работоспособность парсера на всех зонах for my $zone ( keys %Net::Whois::Raw::Data::servers ) { print "$zone\n"; $zone = lc $zone; my $domain = "www.$zone"; my $d_info = parse_whois(domain => $domain); ok $d_info, "\t\t$zone\tparse_whois"; ok exists $d_info->{nameservers}, "\t\t$zone\tnameservers"; ok exists $d_info->{emails}, "\t\t$zone\temails"; }