The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl
package Mail::SpamCannibal::IP2ccFlag;
#
use strict;
use vars qw($VERSION);

$VERSION = do { my @r = (q$Revision: 0.02 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

=head1 NAME

Mail::SpamCannibal::IP2ccFlag - by IP, get Country Code & flag.gif

=head1 SYNOPSIS

  use Mail::SpamCannibal::IP2ccFlag;

  ($cc,$flag_file,$ctry_name)=&Mail::SpamCannibal::IP2ccFlag::get($ipaddy,$flag_path);

=head1 DESCRIPTION get

This function fetches the 2 character Country Code, the relative pathname
for the country flag.gif, and the country name. The function returns an empty array if the country
can not be determined or if the dependent modules are not present or the
flags directory is not present. 

The flags directory must be writable by the caller if you plan to allow
Geo::CountryFlags to automatically fetch flags on demand (normal mode).

* ($cc,$flag_file,$ctry_name)=get($ipaddy,$flag_path);

  input:	IPv4 dot quad address,
		[optional] flag directory
  returns:	CC, path2flagfile.gif, countryname
	    or	()

The default flag directory is "./flags"

This function will retrieve a copy of the requested flag gif from the CIA
web site if it is not present in the "flags" directory.

=cut

sub get {
  my($ip,$fp) = @_;
  $fp = './flags' unless $fp;
  return () unless -d $fp;
  return () unless $ip =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/;
  $ip = $&;
  eval {
	require Geo::IP::PurePerl;
	require Geo::CountryFlags;
  };
  return () if $@;	# punt if errors

  (my $cc = Geo::IP::PurePerl->new()->country_code_by_addr($ip))
	or return ();
  (my $flag = Geo::CountryFlags->new()->get_flag($cc,$fp))
	or return ();
  my $ctry = '';
  if (eval {require Geo::CountryFlags::ISO}) {
    $ctry = Geo::CountryFlags::ISO::value($cc) || '';
  }
  return ($cc,$flag,$ctry);
}

=head1 DEPENDENCIES

  Geo::IP::PurePerl
  Geo::CountryFlags
  GeoIP.dat

=head1 EXPORT

  none

=head1 COPYRIGHT

Copyright 2003 - 2008, Michael Robinton <michael@bizsystems.com>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or 
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

=head1 AUTHOR

Michael Robinton <michael@bizsystems.com>

=head1 SEE ALSO

L<Geo::IP::PurePerl>, L<Geo::CountryFlags>,
http://www.maxmind.com/download/geoip/database/

=cut

1;