r76056 - in /branches/upstream/libnet-whois-parser-perl: ./ current/ current/examples/ current/lib/ current/lib/Net/ current/lib/Net/Whois/ current/t/
jotamjr-guest at users.alioth.debian.org
jotamjr-guest at users.alioth.debian.org
Sat Jun 18 22:29:45 UTC 2011
Author: jotamjr-guest
Date: Sat Jun 18 22:29:36 2011
New Revision: 76056
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=76056
Log:
[svn-inject] Installing original source of libnet-whois-parser-perl (0.05)
Added:
branches/upstream/libnet-whois-parser-perl/
branches/upstream/libnet-whois-parser-perl/current/
branches/upstream/libnet-whois-parser-perl/current/Build.PL
branches/upstream/libnet-whois-parser-perl/current/Changes
branches/upstream/libnet-whois-parser-perl/current/MANIFEST
branches/upstream/libnet-whois-parser-perl/current/META.yml
branches/upstream/libnet-whois-parser-perl/current/Makefile.PL
branches/upstream/libnet-whois-parser-perl/current/README
branches/upstream/libnet-whois-parser-perl/current/examples/
branches/upstream/libnet-whois-parser-perl/current/examples/info.pl (with props)
branches/upstream/libnet-whois-parser-perl/current/examples/key_count.pl (with props)
branches/upstream/libnet-whois-parser-perl/current/examples/keys_by_whois.pl (with props)
branches/upstream/libnet-whois-parser-perl/current/lib/
branches/upstream/libnet-whois-parser-perl/current/lib/Net/
branches/upstream/libnet-whois-parser-perl/current/lib/Net/Whois/
branches/upstream/libnet-whois-parser-perl/current/lib/Net/Whois/Parser.pm
branches/upstream/libnet-whois-parser-perl/current/t/
branches/upstream/libnet-whois-parser-perl/current/t/000-base.t
branches/upstream/libnet-whois-parser-perl/current/t/001-parse-all-zones.pl
Added: branches/upstream/libnet-whois-parser-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/Build.PL?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/Build.PL (added)
+++ branches/upstream/libnet-whois-parser-perl/current/Build.PL Sat Jun 18 22:29:36 2011
@@ -1,0 +1,18 @@
+use strict;
+use warnings;
+use Module::Build;
+
+my $builder = Module::Build->new(
+ module_name => 'Net::Whois::Parser',
+ license => 'perl',
+ dist_author => 'Ivan Sokolov <ivsokolov at cpan.org>',
+ 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();
Added: branches/upstream/libnet-whois-parser-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/Changes?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/Changes (added)
+++ branches/upstream/libnet-whois-parser-perl/current/Changes Sat Jun 18 22:29:36 2011
@@ -1,0 +1,16 @@
+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
Added: branches/upstream/libnet-whois-parser-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/MANIFEST?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/MANIFEST (added)
+++ branches/upstream/libnet-whois-parser-perl/current/MANIFEST Sat Jun 18 22:29:36 2011
@@ -1,0 +1,12 @@
+Build.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
Added: branches/upstream/libnet-whois-parser-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/META.yml?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/META.yml (added)
+++ branches/upstream/libnet-whois-parser-perl/current/META.yml Sat Jun 18 22:29:36 2011
@@ -1,0 +1,22 @@
+---
+abstract: 'module for parsing whois information'
+author:
+ - 'Ivan Sokolov <ivsokolov at cpan.org>'
+build_requires:
+ Net::Whois::Raw: 2
+ Test::More: 0
+configure_requires:
+ Module::Build: 0.36
+generated_by: 'Module::Build version 0.3603'
+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.05
+resources:
+ license: http://dev.perl.org/licenses/
+version: 0.05
Added: branches/upstream/libnet-whois-parser-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/Makefile.PL?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/Makefile.PL (added)
+++ branches/upstream/libnet-whois-parser-perl/current/Makefile.PL Sat Jun 18 22:29:36 2011
@@ -1,0 +1,15 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.3603
+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' => {}
+ )
+;
Added: branches/upstream/libnet-whois-parser-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/README?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/README (added)
+++ branches/upstream/libnet-whois-parser-perl/current/README Sat Jun 18 22:29:36 2011
@@ -1,0 +1,39 @@
+Net-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.
Added: branches/upstream/libnet-whois-parser-perl/current/examples/info.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/examples/info.pl?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/examples/info.pl (added)
+++ branches/upstream/libnet-whois-parser-perl/current/examples/info.pl Sat Jun 18 22:29:36 2011
@@ -1,0 +1,19 @@
+#!/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";
+
+
Propchange: branches/upstream/libnet-whois-parser-perl/current/examples/info.pl
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libnet-whois-parser-perl/current/examples/key_count.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/examples/key_count.pl?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/examples/key_count.pl (added)
+++ branches/upstream/libnet-whois-parser-perl/current/examples/key_count.pl Sat Jun 18 22:29:36 2011
@@ -1,0 +1,39 @@
+#!/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";
Propchange: branches/upstream/libnet-whois-parser-perl/current/examples/key_count.pl
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libnet-whois-parser-perl/current/examples/keys_by_whois.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/examples/keys_by_whois.pl?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/examples/keys_by_whois.pl (added)
+++ branches/upstream/libnet-whois-parser-perl/current/examples/keys_by_whois.pl Sat Jun 18 22:29:36 2011
@@ -1,0 +1,51 @@
+#!/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";
+}
+
Propchange: branches/upstream/libnet-whois-parser-perl/current/examples/keys_by_whois.pl
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libnet-whois-parser-perl/current/lib/Net/Whois/Parser.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/lib/Net/Whois/Parser.pm?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/lib/Net/Whois/Parser.pm (added)
+++ branches/upstream/libnet-whois-parser-perl/current/lib/Net/Whois/Parser.pm Sat Jun 18 22:29:36 2011
@@ -1,0 +1,468 @@
+package Net::Whois::Parser;
+
+use strict;
+
+use utf8;
+use Net::Whois::Raw;
+use Data::Dumper;
+
+our $VERSION = '0.05';
+
+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 at 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 at 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 usefull 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<< <ivsokolov at cpan.org> >>
+
+=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
Added: branches/upstream/libnet-whois-parser-perl/current/t/000-base.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/t/000-base.t?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/t/000-base.t (added)
+++ branches/upstream/libnet-whois-parser-perl/current/t/000-base.t Sat Jun 18 22:29:36 2011
@@ -1,0 +1,55 @@
+#!/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->{emails}->[0], 'info at reg.ru', 'reg.ru email';
+
+$raw = "
+ Test 1: test
+ Test-2:wefwef wef
+ test3: value:value
+";
+$info = parse_whois( raw => $raw );
+
+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 );
+
+is_deeply $info->{test}, [ 1, 2, 3], 'get_all_values is on';
+
+
Added: branches/upstream/libnet-whois-parser-perl/current/t/001-parse-all-zones.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-whois-parser-perl/current/t/001-parse-all-zones.pl?rev=76056&op=file
==============================================================================
--- branches/upstream/libnet-whois-parser-perl/current/t/001-parse-all-zones.pl (added)
+++ branches/upstream/libnet-whois-parser-perl/current/t/001-parse-all-zones.pl Sat Jun 18 22:29:36 2011
@@ -1,0 +1,27 @@
+#!/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";
+
+}
More information about the Pkg-perl-cvs-commits
mailing list