File Coverage

blib/lib/Locale/Geocode.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Locale::Geocode;

use strict;

=head1 NAME

Locale::Geocode

=head1 DESCRIPTION

Locale::Geocode is a module that provides an
interface with which to find codes and information
on geographical locations and their administrative
subdivisions as defined primarily by ISO 3166-1
and ISO 3166-2.  It is the most complete ISO 3166
module available on CPAN.

Also included are, where applicable, FIPS codes.

=head1 SYNOPSIS

 my $lc     = new Locale::Geocode;

 # retrieve a Locale::Geocode::Territory object
 # for the ISO 3166-1 alpha-2 code 'US'
 my $lct    = $lc->lookup('US');

 # retrieve ISO 3166-1 information for US
 my $name   = $lct->name;   # United States
 my $alpha2 = $lct->alpha2; # US
 my $alpha3 = $lct->alpha3; # USA
 my $num    = $lct->num;    # 840

 # lookup a subdivision of US
 my $lcd    = $lct->lookup('TN');

 # retrieve ISO 3166-2 information for US-TN
 my $name   = $lcd->name;   # Tennessee
 my $code   = $lcd->code;   # TN

 # returns an array of Locale::Geocode::Division
 # objects representing all divisions of US
 my @divs   = $lct->divisions;

 # retrieve a Locale::Geocode::Division object
 # for the ISO 3166-1/ISO 3166-2 combo 'GB-ESS'
 my $lct    = $lc->lookup('GB-ESS');

 # retrieve ISO 3166-2 information for GB-ESS
 # as well as special regional information
 my $name   = $lct->name;   # Essex
 my $code   = $lct->name;   # ESS
 my $region = $lct->region; # ENG

=head1 SOURCES

 Wikipedia - http://en.wikipedia.org/wiki/ISO_3166
 Statoids - http://www.statoids.com

=head1 CONFORMING TO

 BS 6879
 ISO 3166-1
 ISO 3166-1 Newsletter V-1 (1998-02-05; Samoa)
 ISO 3166-1 Newsletter V-2 (1999-10-01; Occupied Palestinian Territory)
 ISO 3166-1 Newsletter V-3 (2002-02-01; Romania)
 ISO 3166-1 Newsletter V-4 (2002-05-20; Name changes)
 ISO 3166-1 Newsletter V-5 (2002-05-20; East Timor)
 ISO 3166-1 Newsletter V-6 (2002-11-15; Timor-Leste)
 ISO 3166-1 Newsletter V-7 (2003-01-14; Comoros)
 ISO 3166-1 Newsletter V-8 (2003-07-23; Serbia and Montenegro)
 ISO 3166-1 Newsletter V-9 (2004-02-13; Åland Islands)
 ISO 3166-1 Newsletter V-10 (2004-04-26; Name changes)
 ISO 3166-1 Newsletter V-11 (2006-03-29; Jersey, Guernsey, Isle of Man)
 ISO 3166-1 Newsletter V-12 (2006-09-26; Serbia, Montenegro)
 ISO 3166-2
 ISO 3166-2 Newsletter I-1 (2000-06-12)
 ISO 3166-2 Newsletter I-2 (2002-05-21)
 ISO 3166-2 Newsletter I-3 (2002-08-20)
 ISO 3166-2 Newsletter I-4 (2002-12-10)
 ISO 3166-2 Newsletter I-5 (2003-09-05)
 ISO 3166-2 Newsletter I-6 (2004-03-08)
 ISO 3166-2 Newsletter I-7 (2006-09-12)

=cut

our $VERSION = 1.20;

use Locale::Geocode::Territory;
use Locale::Geocode::Division;
use XML::Simple;

# XML::SAX::PurePerl barfs for some reason :/
$XML::Simple::PREFERRED_PARSER = 'XML::SAX::Expat';

# Locale::Geocode extensions.  the following recognized extensions
# are switchable flags that alter the behavior of the lookup methods.
# many of these extensions are part of the ISO 3166 standard as a
# courtesy to other international organizations (such as the UPU or
# ITU).  others are specific to Locale::Geocode for other practical
# reasons (such as the usm extension for US overseas military or
# usps for all US postal abbreviations).
my @exts = qw(upu wco itu uk fx eu usm usps ust);
my @defs = qw(ust);

# parse the XML data
my $opts = { ForceArray => [ 'division', 'ext', 'note' ], KeyAttr => [], SuppressEmpty => 1 };
my $data = { raw => XMLin(\*DATA, %$opts) };

# create lookup tables
foreach my $href (@{ $data->{raw}->{territory} }) {
	my $aref = $href->{division};

	$href->{divs_code} = { map { lc($_->{code}), $_ } grep { defined $_->{code} } @$aref };
	$href->{divs_fips} = { map { lc($_->{fips}), $_ } grep { defined $_->{fips} } @$aref };
	$href->{divs_name} = { map { lc($_->{name}), $_ } grep { defined $_->{name} } @$aref };
}

my $aref = $data->{raw}->{territory};

$data->{alpha2}	= { map { lc($_->{alpha2})	=> $_ } grep { defined $_->{alpha2} }	@$aref };
$data->{alpha3}	= { map { lc($_->{alpha3})	=> $_ } grep { defined $_->{alpha3} }	@$aref };
$data->{name}	= { map { lc($_->{name})	=> $_ } grep { defined $_->{name} }		@$aref };

=head1 METHODS

=over 4

=item new

=cut

sub new
{
	my $proto = shift;
	my $class = ref($proto) || $proto;

	my $args = { @_ };
	my $self = {};

	bless $self, $class;

	my @exts = @defs;

	if ($args->{ext}) {
		my $reftype = ref $args->{ext};

		die 'ext argument must be scalar or list reference'
			if $reftype ne '' && $reftype ne 'ARRAY';

		@exts = $reftype eq 'ARRAY' ? @{ $args->{ext} } : $args->{ext};
	}

	$self->ext(@exts);

	return $self;
}

=item lookup

=cut

sub lookup
{
	my $self	= shift;
	my $key		= shift;

	my $lct = new Locale::Geocode::Territory $key, $self;

	if (!$lct && $key =~ /-/) {
		my ($iso3166_1, $iso3166_2) = split '-', $key;

		$lct = new Locale::Geocode::Territory $iso3166_1, $self;

		return $lct->lookup($iso3166_2) if $lct;
	}

	return $lct;
}

=item territories

=cut

sub territories
{
	my $self = shift;

	return map { $self->lookup($_) || () } keys %{ $data->{alpha2} };
}

=item territories_sorted

=cut

sub territories_sorted
{
	my $self = shift;

	return sort { $a->name cmp $b->name } $self->territories;
}

=item territories_sorted_us

=cut

sub territories_sorted_us
{
	my $self = shift;

	sub sorted_us
	{
		return -1 if $a->alpha2 eq 'US';
		return 1  if $b->alpha2 eq 'US';
		return $a->name cmp $b->name;
	};

	return sort sorted_us $self->territories;
}

=item ext

=cut

sub ext
{
	my $self = shift;

	if (scalar @_ > 0) {
		$self->{ext} =
		{
			ust => 1, # 'ust' is always on unless explicitly disabled
			map {
				/^-(.*)$/
					? ($1 => 0)
					: $_ eq 'all'
						? map { $_ => 1 } @exts
						: ($_ => 1)
			} @_
		};
	}

	return grep { $self->{ext}->{$_} } keys %{ $self->{ext} };
}

=item ext_enable

=cut

sub ext_enable
{
	my $self = shift;

	foreach my $ext (@_) {
		$self->{ext}->{$ext} = 1 if grep { $ext eq $_ } @exts;
	}
}

=item ext_disable

=cut

sub ext_disable
{
	my $self = shift;

	delete $self->{ext}->{$_} foreach @_;
}

sub chkext
{
	my $self = shift;
	my $href = shift;

	return $href->{ext} ? grep { $self->{ext}->{$_} } @{ $href->{ext} } : 1;
}

sub data { return $data }

sub import { @defs = @_[1..$#_] }

=back

=cut

=head1 AUTHOR

 Mike Eldridge

=head1 CREDITS

 Kim Ryan

=head1 SEE ALSO

 L
 L

=cut

1;

__DATA__