r30661 - in /trunk/libgeo-ipfree-perl: Changes META.yml Makefile.PL debian/changelog lib/Geo/IPfree.pm t/basic.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Fri Feb 13 13:51:08 UTC 2009
Author: gregoa
Date: Fri Feb 13 13:51:05 2009
New Revision: 30661
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=30661
Log:
New upstream release.
Modified:
trunk/libgeo-ipfree-perl/Changes
trunk/libgeo-ipfree-perl/META.yml
trunk/libgeo-ipfree-perl/Makefile.PL
trunk/libgeo-ipfree-perl/debian/changelog
trunk/libgeo-ipfree-perl/lib/Geo/IPfree.pm
trunk/libgeo-ipfree-perl/t/basic.t
Modified: trunk/libgeo-ipfree-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgeo-ipfree-perl/Changes?rev=30661&op=diff
==============================================================================
--- trunk/libgeo-ipfree-perl/Changes (original)
+++ trunk/libgeo-ipfree-perl/Changes Fri Feb 13 13:51:05 2009
@@ -1,4 +1,7 @@
Revision history for Perl extension Geo::IPfree.
+
+0.5 Feb 03 2009
+ - include Memoize in prereqs for older perls
0.4 Dec 01 2008
- fix "undef" test
Modified: trunk/libgeo-ipfree-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgeo-ipfree-perl/META.yml?rev=30661&op=diff
==============================================================================
--- trunk/libgeo-ipfree-perl/META.yml (original)
+++ trunk/libgeo-ipfree-perl/META.yml Fri Feb 13 13:51:05 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Geo-IPfree
-version: 0.4
+version: 0.5
abstract: Look up country of IP Address. This module make this off-line and the DB of IPs is free & small.
license: perl
author:
@@ -8,6 +8,7 @@
generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module
requires:
+ Memoize: 0
Test::More: 0.47
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
Modified: trunk/libgeo-ipfree-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgeo-ipfree-perl/Makefile.PL?rev=30661&op=diff
==============================================================================
--- trunk/libgeo-ipfree-perl/Makefile.PL (original)
+++ trunk/libgeo-ipfree-perl/Makefile.PL Fri Feb 13 13:51:05 2009
@@ -12,6 +12,7 @@
(eval { ExtUtils::MakeMaker->VERSION(6.21) } ? (LICENSE => 'perl') : ()),
PREREQ_PM => {
'Test::More' => '0.47',
+ 'Memoize' => 0,
},
);
Modified: trunk/libgeo-ipfree-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgeo-ipfree-perl/debian/changelog?rev=30661&op=diff
==============================================================================
--- trunk/libgeo-ipfree-perl/debian/changelog (original)
+++ trunk/libgeo-ipfree-perl/debian/changelog Fri Feb 13 13:51:05 2009
@@ -1,3 +1,9 @@
+libgeo-ipfree-perl (0.5-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org> Fri, 13 Feb 2009 14:49:13 +0100
+
libgeo-ipfree-perl (0.4-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libgeo-ipfree-perl/lib/Geo/IPfree.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgeo-ipfree-perl/lib/Geo/IPfree.pm?rev=30661&op=diff
==============================================================================
--- trunk/libgeo-ipfree-perl/lib/Geo/IPfree.pm (original)
+++ trunk/libgeo-ipfree-perl/lib/Geo/IPfree.pm Fri Feb 13 13:51:05 2009
@@ -19,20 +19,21 @@
package Geo::IPfree;
use 5.006;
+use strict;
+use warnings;
+
use Memoize;
-use Carp qw() ;
-use strict qw(vars) ;
-use warnings;
+use Carp qw();
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '0.4';
-
-our @EXPORT = qw(LookUp LoadDB) ;
-our @EXPORT_OK = @EXPORT ;
-
-my $def_db = 'ipscountry.dat' ;
+our $VERSION = '0.5';
+
+our @EXPORT = qw(LookUp LoadDB);
+our @EXPORT_OK = @EXPORT;
+
+my $def_db = 'ipscountry.dat';
my @baseX = ( qw(0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z .), ',', qw(; ' " ` < > { } [ ] = + - ~ * @), '#', qw(% $ & ! ?) );
@@ -61,171 +62,171 @@
VG), 'Virgin_Islands,_British', 'VI', 'Virgin_Islands,_U.S.', qw(VN Vietnam VU Vanuatu WF Wallis_and_Futuna WS Samoa YE Yemen YT Mayotte YU Yugoslavia ZA South_Africa ZM Zambia ZR Zaire ZW Zimbabwe
) );
-my (%baseX,$base,$THIS) ;
-
-my $cache_expire = 1000 ;
+my (%baseX,$base,$THIS);
+
+my $cache_expire = 1000;
# DECLARE BASE LIB
{
- my $c = 0 ;
- %baseX = map { $_ => ($c++) } @baseX ;
- $base = @baseX ;
-
- foreach my $Key ( keys %countrys ) { $countrys{$Key} =~ s/_/ /gs ;}
+ my $c = 0;
+ %baseX = map { $_ => ($c++) } @baseX;
+ $base = @baseX;
+
+ foreach my $Key ( keys %countrys ) { $countrys{$Key} =~ s/_/ /gs;}
}
sub new {
- my ($class, $db_file) = @_ ;
+ my ($class, $db_file) = @_;
if ($#_ <= 0 && $_[0] !~ /^[\w:]+$/) {
- $class = 'Geo::IPfree' ;
- $db_file = $_[0] ;
- }
-
- my $this = {} ;
- bless($this , $class) ;
-
- if (!defined $db_file) { $db_file = &find_db_file ;}
-
- $this->{dbfile} = $db_file ;
-
- $this->LoadDB($db_file) ;
-
- $this->{cache} = 1 ;
-
- return( $this ) ;
+ $class = 'Geo::IPfree';
+ $db_file = $_[0];
+ }
+
+ my $this = {};
+ bless($this, $class);
+
+ if (!defined $db_file) { $db_file = &find_db_file;}
+
+ $this->{dbfile} = $db_file;
+
+ $this->LoadDB($db_file);
+
+ $this->{cache} = 1;
+
+ return( $this );
}
sub LoadDB {
- my $this = shift ;
- my ( $db_file ) = @_ ;
-
- if (-d $db_file) { $db_file .= "/$def_db" ;}
-
- if (!-s $db_file) { Carp::croak("Can't load database, blank or not there: $db_file") ;}
-
- $this->{db} = $db_file ;
-
- my ($handler,$buffer) ;
+ my $this = shift;
+ my ( $db_file ) = @_;
+
+ if (-d $db_file) { $db_file .= "/$def_db";}
+
+ if (!-s $db_file) { Carp::croak("Can't load database, blank or not there: $db_file");}
+
+ $this->{db} = $db_file;
+
+ my ($handler,$buffer);
$buffer=0;
- open($handler,$db_file) || Carp::croak("Failed to open database file $db_file for read!") ;
- binmode($handler) ;
-
- if ( $this->{pos} ) { delete($this->{pos}) ;}
-
- while( read($handler, $buffer , 1 , length($buffer) ) ) {
+ open($handler,$db_file) || Carp::croak("Failed to open database file $db_file for read!");
+ binmode($handler);
+
+ if ( $this->{pos} ) { delete($this->{pos});}
+
+ while( read($handler, $buffer, 1, length($buffer) ) ) {
if ($buffer =~ /##headers##(\d+)##$/s ) {
- my $headers ;
- read($handler, $headers , $1 ) ;
+ my $headers;
+ read($handler, $headers, $1 );
my (%head) = ( $headers =~ /(\d+)=(\d+)/gs );
- foreach my $Key ( keys %head ) { $this->{pos}{$Key} = $head{$Key} ;}
- $buffer = '' ;
+ foreach my $Key ( keys %head ) { $this->{pos}{$Key} = $head{$Key};}
+ $buffer = '';
}
elsif ($buffer =~ /##start##$/s ) {
- $this->{start} = tell($handler) ;
- last ;
+ $this->{start} = tell($handler);
+ last;
}
}
- @{$this->{searchorder}} = ( sort {$a <=> $b} keys %{$this->{pos}} ) ;
-
- $this->{handler} = $handler ;
+ @{$this->{searchorder}} = ( sort {$a <=> $b} keys %{$this->{pos}} );
+
+ $this->{handler} = $handler;
}
sub LookUp {
- my $this ;
+ my $this;
if ($#_ == 0) {
- if (!$THIS) { $THIS = Geo::IPfree->new() ;}
- $this = $THIS ;
- }
- else { $this = shift ;}
-
- my ( $ip ) = @_ ;
-
- $ip =~ s/\.+/\./gs ;
- $ip =~ s/^\.// ;
- $ip =~ s/\.$// ;
-
- if ($ip !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { $ip = nslookup($ip) ;}
+ if (!$THIS) { $THIS = Geo::IPfree->new();}
+ $this = $THIS;
+ }
+ else { $this = shift;}
+
+ my ( $ip ) = @_;
+
+ $ip =~ s/\.+/\./gs;
+ $ip =~ s/^\.//;
+ $ip =~ s/\.$//;
+
+ if ($ip !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { $ip = nslookup($ip);}
return unless length $ip;
## Since the last class is always from the same country, will try 0 and cache 0:
- my $ip_class = $ip ;
- $ip_class =~ s/\.\d+$/\.0/ ;
-
- if ( $this->{cache} && $this->{CACHE}{$ip_class} ) { return( @{$this->{CACHE}{$ip_class}} , $ip_class ) ;}
-
- my $ipnb = ip2nb($ip_class) ;
-
- my $buf_pos = 0 ;
+ my $ip_class = $ip;
+ $ip_class =~ s/\.\d+$/\.0/;
+
+ if ( $this->{cache} && $this->{CACHE}{$ip_class} ) { return( @{$this->{CACHE}{$ip_class}}, $ip_class );}
+
+ my $ipnb = ip2nb($ip_class);
+
+ my $buf_pos = 0;
foreach my $Key ( @{$this->{searchorder}} ) {
- if ($ipnb <= $Key) { $buf_pos = $this->{pos}{$Key} ; last ;}
- }
-
- my ($buffer,$country,$iprange) ;
+ if ($ipnb <= $Key) { $buf_pos = $this->{pos}{$Key}; last;}
+ }
+
+ my ($buffer,$country,$iprange);
## Will use the DB in the memory:
if ( $this->{FASTER} ) {
while($buf_pos < $this->{DB_SIZE}) {
- $buffer = substr($this->{DB} , $buf_pos , 7) ;
- $country = substr($buffer , 0 , 2) ;
- $iprange = baseX2dec( substr($buffer , 2 , 5) ) ;
- $buf_pos += 7 ;
- if ($ipnb >= $iprange) { last ;}
+ $buffer = substr($this->{DB}, $buf_pos, 7);
+ $country = substr($buffer, 0, 2);
+ $iprange = baseX2dec( substr($buffer, 2, 5) );
+ $buf_pos += 7;
+ if ($ipnb >= $iprange) { last;}
}
}
## Will read the DB in the disk:
else {
- seek($this->{handler} , 0 , 0) if $] < 5.006001 ; ## Fix bug on Perl 5.6.0
- seek($this->{handler} , $buf_pos + $this->{start} , 0) ;
- while( read($this->{handler} , $buffer , 7) ) {
- $country = substr($buffer , 0 , 2) ;
- $iprange = baseX2dec( substr($buffer , 2) ) ;
- if ($ipnb >= $iprange) { last ;}
+ seek($this->{handler}, 0, 0) if $] < 5.006001; ## Fix bug on Perl 5.6.0
+ seek($this->{handler}, $buf_pos + $this->{start}, 0);
+ while( read($this->{handler}, $buffer, 7) ) {
+ $country = substr($buffer, 0, 2);
+ $iprange = baseX2dec( substr($buffer, 2) );
+ if ($ipnb >= $iprange) { last;}
}
}
if ( $this->{cache} ) {
- $this->{CACHE}{$ip_class} = [$country , $countrys{$country}] ;
- $this->{CACHE}{x}++ ;
- if ( $this->{CACHE}{x} > $cache_expire ) { $this->Clean_Cache ;}
- }
-
- return( $country , $countrys{$country} , $ip_class ) ;
+ $this->{CACHE}{$ip_class} = [$country, $countrys{$country}];
+ $this->{CACHE}{x}++;
+ if ( $this->{CACHE}{x} > $cache_expire ) { $this->Clean_Cache;}
+ }
+
+ return( $country, $countrys{$country}, $ip_class );
}
sub Faster {
- my $this = shift ;
-
- seek($this->{handler} , 0 , 0) ; ## Fix bug on Perl 5.6.0
- seek($this->{handler} , $this->{start} , 0) ;
- 1 while( read($this->{handler}, $this->{DB} , 1024*4 , length($this->{DB}) ) ) ;
-
- $this->{DB_SIZE} = length($this->{DB}) ;
-
- memoize('dec2baseX') ;
- memoize('baseX2dec') ;
+ my $this = shift;
+
+ seek($this->{handler}, 0, 0); ## Fix bug on Perl 5.6.0
+ seek($this->{handler}, $this->{start}, 0);
+ 1 while( read($this->{handler}, $this->{DB}, 1024*4, length($this->{DB}) ) );
+
+ $this->{DB_SIZE} = length($this->{DB});
+
+ memoize('dec2baseX');
+ memoize('baseX2dec');
## Too many memory and not soo fast:
- #memoize('ip2nb') ;
- #memoize('nb2ip') ;
-
- $this->{FASTER} = 1 ;
-}
-
-sub Clean_Cache { delete $_[0]->{CACHE} ; 1 ;}
+ #memoize('ip2nb');
+ #memoize('nb2ip');
+
+ $this->{FASTER} = 1;
+}
+
+sub Clean_Cache { delete $_[0]->{CACHE}; 1;}
sub nslookup {
- my ( $host ) = @_ ;
- require Socket ;
- my $iaddr = Socket::inet_aton($host) ;
+ my ( $host ) = @_;
+ require Socket;
+ my $iaddr = Socket::inet_aton($host);
$iaddr = '' if !defined $iaddr;
- my @ip = unpack('C4',$iaddr) ;
- if (! @ip && ! $_[1]) { return( &nslookup("www.$host",1) ) ;}
- return( join (".", at ip) ) ;
+ my @ip = unpack('C4',$iaddr);
+ if (! @ip && ! $_[1]) { return( &nslookup("www.$host",1) );}
+ return( join (".", at ip) );
}
sub find_db_file {
@@ -242,74 +243,74 @@
}
sub ip2nb {
- my @ip = split(/\./ , $_[0]) ;
- #return( 16777216* $ip[0] + 65536* $ip[1] + 256* $ip[2] + $ip[3] ) ;
- return( ($ip[0]<<24) + ($ip[1]<<16) + ($ip[2]<<8) + $ip[3] ) ;
+ my @ip = split(/\./, $_[0]);
+ #return( 16777216* $ip[0] + 65536* $ip[1] + 256* $ip[2] + $ip[3] );
+ return( ($ip[0]<<24) + ($ip[1]<<16) + ($ip[2]<<8) + $ip[3] );
}
sub nb2ip {
- my ( $ipn ) = @_ ;
-
- my @ip ;
-
- my $x = $ipn ;
+ my ( $ipn ) = @_;
+
+ my @ip;
+
+ my $x = $ipn;
while($x > 1) {
- my $c = $x / 256 ;
- my $ci = int($x / 256) ;
- #push(@ip , $x - ($ci*256)) ;
- push(@ip , $x - ($ci<<8)) ;
- $x = $ci ;
- }
-
- push(@ip , $x) if $x > 0 ;
-
- while( $#ip < 3 ) { push(@ip , 0) ;}
-
- @ip = reverse (@ip) ;
+ my $c = $x / 256;
+ my $ci = int($x / 256);
+ #push(@ip, $x - ($ci*256));
+ push(@ip, $x - ($ci<<8));
+ $x = $ci;
+ }
+
+ push(@ip, $x) if $x > 0;
+
+ while( $#ip < 3 ) { push(@ip, 0);}
+
+ @ip = reverse (@ip);
- return( join (".", @ip) ) ;
+ return( join (".", @ip) );
}
sub dec2baseX {
- my ( $dec ) = @_ ;
-
- my @base ;
- my $x = $dec ;
+ my ( $dec ) = @_;
+
+ my @base;
+ my $x = $dec;
while($x > 1) {
- my $c = $x / $base ;
- my $ci = int($x / $base) ;
- push(@base , $x - ($ci*$base) ) ;
- $x = $ci ;
- }
-
- push(@base , $x) if $x > 0 ;
-
- while( $#base < 4 ) { push(@base , 0) ;}
-
- my $baseX ;
+ my $c = $x / $base;
+ my $ci = int($x / $base);
+ push(@base, $x - ($ci*$base) );
+ $x = $ci;
+ }
+
+ push(@base, $x) if $x > 0;
+
+ while( $#base < 4 ) { push(@base, 0);}
+
+ my $baseX;
foreach my $base_i ( reverse @base ) {
- $baseX .= $baseX[$base_i] ;
- }
-
- return( $baseX ) ;
+ $baseX .= $baseX[$base_i];
+ }
+
+ return( $baseX );
}
sub baseX2dec {
- my ( $baseX ) = @_ ;
-
- my @base = split("" , $baseX) ;
- my $dec ;
-
- my $i = -1 ;
+ my ( $baseX ) = @_;
+
+ my @base = split("", $baseX);
+ my $dec;
+
+ my $i = -1;
foreach my $base_i ( reverse @base ) {
- $i++ ;
- $dec += $baseX{$base_i} * ($base**$i) ;
- }
-
- return( $dec ) ;
+ $i++;
+ $dec += $baseX{$base_i} * ($base**$i);
+ }
+
+ return( $dec );
}
1;
@@ -323,29 +324,29 @@
=head1 SYNOPSIS
use Geo::IPfree;
- my ($country,$country_name) = Geo::IPfree::LookUp("192.168.0.1") ;
+ my ($country,$country_name) = Geo::IPfree::LookUp("192.168.0.1");
... or ...
- use Geo::IPfree qw(LookUp) ;
- my ($country,$country_name) = LookUp("200.176.3.142") ;
+ use Geo::IPfree qw(LookUp);
+ my ($country,$country_name) = LookUp("200.176.3.142");
... or ...
use Geo::IPfree;
- my $GeoIP = Geo::IPfree->new('/GeoIPfree/ipscountry.dat') ;
- $GeoIP->Faster ; ## Enable the faster option.
- my ($country,$country_name,$ip) = $GeoIP->LookUp("www.cnn.com") ; ## Getting by Hostname.
-
- $GeoIP->LoadDB('/GeoIPfree/ips.dat') ;
-
- my ($country,$country_name,$ip) = $GeoIP->LookUp("www.sf.net") ; ## Getting by Hostname.
+ my $GeoIP = Geo::IPfree->new('/GeoIPfree/ipscountry.dat');
+ $GeoIP->Faster; ## Enable the faster option.
+ my ($country,$country_name,$ip) = $GeoIP->LookUp("www.cnn.com"); ## Getting by Hostname.
+
+ $GeoIP->LoadDB('/GeoIPfree/ips.dat');
+
+ my ($country,$country_name,$ip) = $GeoIP->LookUp("www.sf.net"); ## Getting by Hostname.
... or ...
use Geo::IPfree;
- my $GeoIP = Geo::IPfree::new() ; ## Using the default DB!
- my ($country,$country_name) = $GeoIP->LookUp("64.236.24.28") ;
+ my $GeoIP = Geo::IPfree::new(); ## Using the default DB!
+ my ($country,$country_name) = $GeoIP->LookUp("64.236.24.28");
=head1 DESCRIPTION
Modified: trunk/libgeo-ipfree-perl/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgeo-ipfree-perl/t/basic.t?rev=30661&op=diff
==============================================================================
--- trunk/libgeo-ipfree-perl/t/basic.t (original)
+++ trunk/libgeo-ipfree-perl/t/basic.t Fri Feb 13 13:51:05 2009
@@ -36,7 +36,8 @@
is($country_name, 'Europe');
}
-{ # does not exist
+SKIP: { # does not exist
my @result = Geo::IPfree::LookUp('dne.undef');
+ skip '"dne.undef" should not resolve, but it does for you.', 1 if @result == 3;
is( scalar @result, 0, 'undef result' );
}
More information about the Pkg-perl-cvs-commits
mailing list