The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Apache2::GeoIP;

use strict;
use warnings;
use base qw(Exporter);
use vars qw($VERSION @EXPORT_OK);

$VERSION = '1.99_01';
@EXPORT_OK = qw(find_addr);

sub get_remote_ip {
  my ($r) = @_;
  if ($r->can('useragent_ip')) {
    return $r->useragent_ip;
  } else {
    return $r->connection->remote_ip;
  }
}

sub find_addr {
  my ($r, $xforwardedfor) = @_;
  my $host;
  if (defined $xforwardedfor) {
    my $ReIpNum = qr{([01]?\d\d?|2[0-4]\d|25[0-5])};
    my $ReIpAddr = qr{^$ReIpNum\.$ReIpNum\.$ReIpNum\.$ReIpNum$};
    $host =  $r->headers_in->get('X-Forwarded-For') || get_remote_ip($r);
    if ($host =~ /,/) {
      my @a = split /\s*,\s*/, $host;
      for my $i (0 .. $#a) {
          if ($a[$i] =~ /$ReIpAddr/ and $a[$i] ne '127.0.0.1') {
              $host = $a[$i];
              last;
          }
      }
      $host = '127.0.0.1' if $host =~ /,/;
    }
  }
  else {
    $host = get_remote_ip($r);
  }
  return $host;
}


1;

__END__

=head1 NAME

Apache2::GeoIP - Look up country by IP Address

=head1 IP ADDRESS TO COUNTRY DATABASES

Free monthly updates to the database are available from 

  http://www.maxmind.com/download/geoip/database/

This free database is similar to the database contained in IP::Country, as 
well as many paid databases. It uses ARIN, RIPE, APNIC, and LACNIC whois to 
obtain the IP->Country mappings.

For Win32 users, the F<GeoIP.dat> database file is expected
to reside in the F</Program Files/GeoIP/> directory.

If you require greater accuracy, MaxMind offers a Premium database on a paid 
subscription basis. 

=head1 MAILING LISTS AND CVS

A mailing list and cvs access for the GeoIP library are available 
from SourceForge; see http://sourceforge.net/projects/geoip/.

=head1 SEE ALSO

L<Apache2::Geo::IP> and L<Apache2::Geo::Mirror>.

=head1 AUTHOR

The look-up code for associating a country with an IP address 
is based on the GeoIP library and the Geo::IP Perl module, and is 
Copyright (c) 2002, T.J. Mather, tjmather@tjmather.com, New York, NY, 
USA. See http://www.maxmind.com/ for details. The mod_perl interface is 
Copyright (c) 2002, Randy Kobes <randy@theoryx5.uwinnipeg.ca>.

All rights reserved.  This package is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut