Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
  • 3 commits
  • 5 files changed
  • 0 comments
  • 1 contributor
9 META.info
... ... @@ -0,0 +1,9 @@
  1 +{
  2 + "name" : "GeoIP",
  3 + "version" : "0.1",
  4 + "description" : "GeoIP MaxMind library interface",
  5 + "author" : "Pawel Pabian",
  6 + "authority" : "bbkr",
  7 + "depends" : [ "NativeCall" ],
  8 + "source-url" : "git://github.com/bbkr/GeoIPerl6.git"
  9 +}
24 README.md
Source Rendered
... ... @@ -1,5 +1,7 @@
1 1 #GeoIP
2 2
  3 +![World](http://modules.perl6.org/logos/GeoIP.png)
  4 +
3 5 Connect to MaxMind GeoIP database from Perl6.
4 6
5 7 ##INFO
@@ -22,12 +24,30 @@ sudo port install libgeoip GeoLiteCity
22 24 use GeoIP;
23 25 my $g = GeoIP.new;
24 26
25   -say $g.country_code_by_addr('91.192.78.63');
  27 +say $g.country_code( '91.192.78.63' );
  28 +say $g.country_name( '91.192.78.63' );
  29 +say $g.continent_code( '91.192.78.63' );
  30 +```
  31 +
  32 +If everything is installed correctly it should print:
  33 +
  34 +```
  35 +PL
  36 +Poland
  37 +EU
26 38 ```
27 39
28   -If everything is installed correctly it should print ```PL```.
  40 +Using host names is also allowed:
29 41
  42 +```perl
  43 +say $g.country_code( 'bbkr.org' );
  44 +```
30 45
31 46 ##TODO
32 47
33 48 Everything :)
  49 +
  50 +* other operating systems
  51 +* paid databases
  52 +* fetching whole record
  53 +* consistent interface
58 lib/GeoIP.pm
... ... @@ -1,16 +1,56 @@
1   -class GeoIP;
2   -
3 1 use NativeCall;
4 2
5   -has OpaquePointer $!db;
  3 +class GeoIP is repr('CPointer');
  4 +
  5 +# initialize database
  6 +sub GeoIP_new ( Int ) returns GeoIP is native( '/opt/local/lib/libGeoIP.dylib' ) { * }
  7 +sub GeoIP_set_charset (GeoIP, Int ) returns Int is native( '/opt/local/lib/libGeoIP.dylib' ) { * }
  8 +
  9 +# HACK: obtain ID as intermediate level for calls
  10 +# because currently NativeCall segfaults on NULL pointers
  11 +sub GeoIP_id_by_addr ( GeoIP, Str ) returns Int is native( '/opt/local/lib/libGeoIP.dylib' ) { * }
  12 +sub GeoIP_id_by_name ( GeoIP, Str ) returns Int is native( '/opt/local/lib/libGeoIP.dylib' ) { * }
6 13
7   -sub GeoIP_new ( Int ) returns OpaquePointer is native( '/opt/local/lib/libGeoIP.dylib' ) { * }
8   -sub GeoIP_country_code_by_addr ( OpaquePointer, Str ) returns Str is native( '/opt/local/lib/libGeoIP.dylib' ) { * }
  14 +sub GeoIP_code_by_id( Int ) returns Str is native( '/opt/local/lib/libGeoIP.dylib' ) { * }
  15 +sub GeoIP_country_name_by_id( GeoIP, Int ) returns Str is encoded('utf8') is native( '/opt/local/lib/libGeoIP.dylib' ) { * };
  16 +sub GeoIP_name_by_id( Int ) returns Str is native( '/opt/local/lib/libGeoIP.dylib' ) { * };
  17 +sub GeoIP_continent_by_id( Int ) returns Str is native( '/opt/local/lib/libGeoIP.dylib' ) { * };
9 18
10   -submethod BUILD {
11   - $!db = GeoIP_new( 0 );
  19 +method new ( ) {
  20 + my $g = GeoIP_new( 0 );
  21 +
  22 + # GeoIPCharset.GEOIP_CHARSET_UTF8 == 1
  23 + GeoIP_set_charset( $g, 1 );
  24 +
  25 + return $g;
12 26 }
13 27
14   -method country_code_by_addr ( Str $ip ){
15   - return GeoIP_country_code_by_addr( $!db, $ip );
  28 +# avoid "_by_id"" or "_by_addr" suffixes from GeoIP.h
  29 +# and detect type using awesome Perl 6 signatures later
  30 +multi method id ( Str $ip where /^\d+\.\d+\.\d+\.\d+$/ ) {
  31 + return GeoIP_id_by_addr( self, $ip );
16 32 }
  33 +multi method id ( Str $host ) {
  34 + return GeoIP_id_by_name( self, $host );
  35 +}
  36 +
  37 +method country_code ( $location ) {
  38 + my $id = self.id( $location );
  39 +
  40 + return unless $id;
  41 + return GeoIP_code_by_id( $id );
  42 +}
  43 +
  44 +method country_name ( $location ) {
  45 + my $id = self.id( $location );
  46 +
  47 + return unless $id;
  48 + return GeoIP_country_name_by_id( self, $id );
  49 +}
  50 +
  51 +method continent_code ( $location ) {
  52 + my $id = self.id( $location );
  53 +
  54 + return unless $id;
  55 + return GeoIP_continent_by_id( $id );
  56 +}
BIN  logotype/logo_32x32.png
22 t/basic.t
... ... @@ -0,0 +1,22 @@
  1 +BEGIN { @*INC.unshift('lib') }
  2 +
  3 +use Test;
  4 +use GeoIP;
  5 +
  6 +plan( 9 );
  7 +
  8 +my $g;
  9 +
  10 +lives_ok { $g = GeoIP.new }, 'initialize database';
  11 +
  12 +is $g.country_code( 'perl.org' ), 'US', 'country_code found by host';
  13 +is $g.country_code( '207.171.7.63' ), 'US', 'country_code found by ip';
  14 +ok not $g.country_code( '0.0.0.0').defined, 'country_code missing';
  15 +
  16 +is $g.country_code( 'perlgeek.de' ), 'DE', 'country_code found by host';
  17 +is $g.country_name( '213.95.10.24' ), 'Germany', 'country_name found ';
  18 +ok not $g.country_name( '0.0.0.0').defined, 'country_name missing';
  19 +
  20 +is $g.continent_code( '91.192.78.63' ), 'EU', 'continent_code found by ip';
  21 +ok not $g.country_name( '0.0.0.0').defined, 'continent_code missing';
  22 +

No commit comments for this range

Something went wrong with that request. Please try again.