Net-Whois-Parser-0.07000755001750001750 011706242553 14757 5ustar00vaneskavaneska000000000000Net-Whois-Parser-0.07/MANIFEST000444001750001750 27711706242553 16233 0ustar00vaneskavaneska000000000000Build.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.07/Changes000444001750001750 120011706242553 16400 0ustar00vaneskavaneska0000000000000.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.07/META.yml000444001750001750 107511706242553 16370 0ustar00vaneskavaneska000000000000--- abstract: 'module for parsing whois information' author: - 'Ivan Sokolov ' build_requires: Net::Whois::Raw: 2 Test::More: 0 configure_requires: Module::Build: 0.38 dynamic_config: 1 generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.112150' 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.07 resources: license: http://dev.perl.org/licenses/ version: 0.07 Net-Whois-Parser-0.07/Makefile.PL000444001750001750 60511706242553 17047 0ustar00vaneskavaneska000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.3800 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.07/README000444001750001750 147511706242553 16003 0ustar00vaneskavaneska000000000000Net-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.07/META.json000444001750001750 167611706242553 16547 0ustar00vaneskavaneska000000000000{ "abstract" : "module for parsing whois information", "author" : [ "Ivan Sokolov " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.38, CPAN::Meta::Converter version 2.112150", "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.38" } } }, "provides" : { "Net::Whois::Parser" : { "file" : "lib/Net/Whois/Parser.pm", "version" : "0.07" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.07" } Net-Whois-Parser-0.07/Build.PL000444001750001750 76211706242553 16375 0ustar00vaneskavaneska000000000000use 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', ); $builder->create_build_script(); Net-Whois-Parser-0.07/examples000755001750001750 011706242553 16575 5ustar00vaneskavaneska000000000000Net-Whois-Parser-0.07/examples/keys_by_whois.pl000555001750001750 171011706242553 22147 0ustar00vaneskavaneska000000000000#!/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.07/examples/info.pl000555001750001750 52111706242553 20203 0ustar00vaneskavaneska000000000000#!/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.07/examples/key_count.pl000555001750001750 130211706242553 21266 0ustar00vaneskavaneska000000000000#!/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.07/lib000755001750001750 011706242553 15525 5ustar00vaneskavaneska000000000000Net-Whois-Parser-0.07/lib/Net000755001750001750 011706242553 16253 5ustar00vaneskavaneska000000000000Net-Whois-Parser-0.07/lib/Net/Whois000755001750001750 011706242553 17344 5ustar00vaneskavaneska000000000000Net-Whois-Parser-0.07/lib/Net/Whois/Parser.pm000444001750001750 3615211706242553 21322 0ustar00vaneskavaneska000000000000package Net::Whois::Parser; use strict; use utf8; use Net::Whois::Raw; use Data::Dumper; our $VERSION = '0.07'; 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', # domain domain_name => 'domain', domainname => 'domain', # creation_date created => 'creation_date', created_on => 'creation_date', creation_date => 'creation_date', domain_registration_date => '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; 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.07/t000755001750001750 011706242553 15222 5ustar00vaneskavaneska000000000000Net-Whois-Parser-0.07/t/000-base.t000444001750001750 250411706242553 16754 0ustar00vaneskavaneska000000000000#!/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 => 11; 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 "; $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 :'; #### $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.07/t/001-parse-all-zones.pl000444001750001750 112211706242553 21222 0ustar00vaneskavaneska000000000000#!/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"; }