File Coverage

blib/lib/Plack/Middleware/GeoIP.pm
Criterion Covered Total %
statement 17 70 24.2
branch 0 40 0.0
condition 0 6 0.0
subroutine 6 9 66.6
pod 2 3 66.6
total 25 128 19.5


line stmt bran cond sub pod time code
1             package Plack::Middleware::GeoIP;
2 1     1   20890 use strict;
  1         2  
  1         25  
3 1     1   5 use warnings;
  1         2  
  1         26  
4 1     1   20 use 5.008;
  1         8  
5             our $VERSION = 0.04;
6 1     1   830 use parent qw/Plack::Middleware/;
  1         297  
  1         6  
7 1     1   19034 use Geo::IP;
  1         50671  
  1         213  
8              
9 1     1   12 use Plack::Util::Accessor qw( GeoIPDBFile GeoIPEnableUTF8 );
  1         2  
  1         11  
10              
11             sub geoip_flag {
12 0     0 0   my $self = shift;
13 0           my $flag = shift;
14              
15 0 0         return GEOIP_MEMORY_CACHE if $flag eq 'MemoryCache';
16 0 0         return GEOIP_CHECK_CACHE if $flag eq 'CheckCache';
17 0 0         return GEOIP_INDEX_CACHE if $flag eq 'IndexCache';
18 0 0         return GEOIP_MMAP_CACHE if $flag eq 'MMapCache';
19 0           return GEOIP_STANDARD;
20             }
21              
22             sub prepare_app {
23 0     0 1   my $self = shift;
24              
25 0 0         if (my $dbfiles = $self->GeoIPDBFile) {
26 0 0         my @dbfiles = ref $dbfiles ? @{ $dbfiles } : ($dbfiles);
  0            
27 0           foreach my $dbfile (@dbfiles) {
28 0 0         my ($filename, $flag) = ref $dbfile ? @{ $dbfile } : ($dbfile, 'Standard');
  0            
29              
30             # combine flags
31 0 0         my @flags = ref $flag ? @{ $flag } : ($flag);
  0            
32 0           my $flags = GEOIP_STANDARD;
33 0           foreach my $f (@flags) {
34 0           $flags |= $self->geoip_flag($f);
35             }
36              
37 0           my $gi = Geo::IP->open($filename, $flags);
38 0 0         $gi->set_charset(GEOIP_CHARSET_UTF8) if $self->GeoIPEnableUTF8;
39 0           push @{ $self->{gips} }, $gi;
  0            
40             }
41             } else {
42 0           my $gi = Geo::IP->new(GEOIP_STANDARD);
43 0           push @{ $self->{gips} }, $gi;
  0            
44             }
45             }
46              
47             sub call {
48 0     0 1   my $self = shift;
49 0           my $env = shift;
50              
51 0           my $ipaddr = $env->{REMOTE_ADDR};
52              
53 0           foreach my $gi (@{ $self->{gips} }) {
  0            
54 0           my $type = $gi->database_edition;
55 0 0 0       if (GEOIP_COUNTRY_EDITION == $type) {
    0          
56 0 0         if (my $code = $gi->country_code_by_addr($ipaddr)) {
57 0           $env->{GEOIP_COUNTRY_CODE} = $code;
58 0           $env->{GEOIP_COUNTRY_CODE3} = $gi->country_code3_by_addr($ipaddr);
59 0           $env->{GEOIP_COUNTRY_NAME} = $gi->country_name_by_addr($ipaddr);
60 0           $env->{GEOIP_CONTINENT_CODE} = $gi->continent_code_by_country_code($code);
61             }
62             } elsif (GEOIP_CITY_EDITION_REV0 == $type or GEOIP_CITY_EDITION_REV1 == $type) {
63 0 0         if (my $record = $gi->record_by_addr($ipaddr)) {
64 0           $env->{GEOIP_COUNTRY_CODE} = $record->country_code;
65 0           $env->{GEOIP_COUNTRY_CODE3} = $record->country_code3;
66 0           $env->{GEOIP_COUNTRY_NAME} = $record->country_name;
67 0           $env->{GEOIP_LATITUDE} = $record->latitude;
68 0           $env->{GEOIP_LONGITUDE} = $record->longitude;
69 0           $env->{GEOIP_CONTINENT_CODE} = $record->continent_code;
70 0 0         $env->{GEOIP_TIME_ZONE} = $record->time_zone if $record->time_zone;
71 0 0         $env->{GEOIP_REGION} = $record->region if $record->region;
72 0 0 0       $env->{GEOIP_REGION_NAME} = $record->region_name if $record->region and $record->region_name;
73 0 0         $env->{GEOIP_CITY} = $record->city if $record->city;
74 0 0         $env->{GEOIP_POSTAL_CODE} = $record->postal_code if $record->postal_code;
75 0 0         $env->{GEOIP_METRO_CODE} = $record->metro_code if $record->metro_code;
76 0 0         $env->{GEOIP_AREA_CODE} = $record->area_code if $record->area_code;
77             }
78             }
79             }
80              
81 0           return $self->app->($env);
82             }
83              
84             1;
85              
86             =head1 NAME
87              
88             Plack::Middleware::GeoIP - Find country and city of origin of a web request
89              
90             =head1 SYNOPSIS
91              
92             # with Plack::Middleware::RealIP
93             enable 'Plack::Middleware::RealIP',
94             header => 'X-Forwarded-For',
95             trusted_proxy => [ qw(192.168.1.0/24 192.168.2.1) ];
96             enable 'Plack::Middleware::GeoIP',
97             GeoIPDBFile => [ '/path/to/GeoIP.dat', '/path/to/GeoIPCity.dat' ],
98             GeoIPEnableUTF8 => 1;
99              
100             =head1 DESCRIPTION
101              
102             Plack::Middleware::GeoIP is a loose port of the Apache module
103             mod_geoip. It uses Geo::IP to lookup the country and city that a web
104             request originated from.
105              
106             All requests are looked up and GEOIP_* variables are added to PSGI
107             environment hash. For improved performance, you may want to only enable
108             this middleware for specific URL's.
109              
110             The following PSGI environment variables are set by this middleware:
111              
112             GeoIP Country Edition:
113              
114             GEOIP_COUNTRY_CODE, GEOIP_COUNTRY_CODE3, GEOIP_COUNTRY_NAME,
115             GEOIP_CONTINENT_CODE
116              
117             GeoIP City Edition:
118              
119             GEOIP_COUNTRY_CODE, GEOIP_COUNTRY_CODE3, GEOIP_COUNTRY_NAME,
120             GEOIP_CONTINENT_CODE, GEOIP_LATITUDE, GEOIP_LONGITUDE, GEOIP_TIME_ZONE,
121             GEOIP_REGION, GEOIP_REGION_NAME, GEOIP_CITY, GEOIP_POSTAL_CODE,
122             GEOIP_METRO_CODE, GEOIP_AREA_CODE
123              
124             =head1 CONFIGURATION
125              
126             =over 4
127              
128             =item GeoIPDBFile
129              
130             GeoIPDBFile => '/path/to/GeoIP.dat'
131             GeoIPDBFile => [ '/path/to/GeoIP.dat', '/path/to/GeoIPCity.dat' ]
132             GeoIPDBFile => [ '/path/to/GeoIP.dat', [ '/path/to/GeoIPCity.dat', 'MemoryCache' ] ]
133             GeoIPDBFile => [ '/path/to/GeoIP.dat', [ '/path/to/GeoIPCity.dat', [ qw(MemoryCache CheckCache) ] ] ]
134              
135             Path to GeoIP data file. GeoIP flags may also be specified. Accepted
136             flags are Standard, MemoryCache, CheckCache, IndexCache, and MMapCache.
137              
138             =item GeoIPEnableUTF8
139              
140             GeoIPEnableUTF8 => 1
141              
142             Turn on utf8 characters for city names.
143              
144             =back
145              
146             =head1 AUTHOR
147              
148             Sherwin Daganato Esherwin@daganato.comE
149              
150             =head1 LICENSE
151              
152             This library is free software; you can redistribute it and/or modify
153             it under the same terms as Perl itself.
154              
155             =head1 SEE ALSO
156              
157             L
158              
159             L
160              
161             =cut