/lib/Geo/GeoNames.pm

# $Id: GeoNames.pm 45 2008-03-27 14:52:56Z per.henrik.johansen@gmail.com $

package Geo::GeoNames;



use Data::Dumper;

use 5.008006;

use strict;

use warnings;

use Carp;

use XML::Simple;

use LWP;

use JSON;



use vars qw($VERSION $DEBUG $GNURL $CACHE %valid_parameters %searches);



our $VERSION = '0.07svn';

$GNURL = 'http://ws.geonames.org';



%searches = (

	children => 'children?',

	cities => 'cities?',

	country_code => 'countrycode?type=xml&',

	country_info => 'countryInfo?', 

	earthquakes => 'earthquakesJSON?',

	find_nearby_placename => 'findNearbyPlaceName?',

	find_nearby_postalcodes => 'findNearbyPostalCodes?',

	find_nearby_streets => 'findNearbyStreets?',

	find_nearby_weather => 'findNearByWeatherXML?',

	find_nearby_wikipedia => 'findNearbyWikipedia?',

	find_nearby_wikipedia_by_postalcode => 'findNearbyWikipedia?',

	find_nearest_address => 'findNearestAddress?',

	find_nearest_intersection => 'findNearestIntersection?',

	postalcode_country_info => 'postalCodeCountryInfo?',

	postalcode_search => 'postalCodeSearch?',

	search => 'search?',

	wikipedia_bounding_box => 'wikipediaBoundingBox?',

	wikipedia_search => 'wikipediaSearch?',

);



# 	r 	= required

#	o	= optional

#	rc	= required - only one of the fields marked with rc is allowed. At least one must be present

#	om	= optional, multible entries allowed

#	d	= depreciated - will be removed in later versions

%valid_parameters = (

	search => {

				q		=> 'rc',

				name		=> 'rc',

				name_equals	=> 'rc,',

				maxRows 	=> 'o',

				startRow	=> 'o',

				country		=> 'om',

				continentCode	=> 'o',

				adminCode1	=> 'o',

				adminCode2	=> 'o',

				adminCode3	=> 'o',

				fclass		=> 'omd',

				featureClass	=> 'om',

				featureCode	=> 'om',

				lang		=> 'o',

				type		=> 'o',

				style		=> 'o',

				isNameRequired	=> 'o',

				tag		=> 'o'

				},

	postalcode_search => {

				postalcode	=> 'rc',

				placename	=> 'rc',

				country		=> 'o',

				maxRows		=> 'o',

				style		=> 'o'

				},

	find_nearby_postalcodes => {

				lat		=> 'r',

				lng		=> 'r',

				radius		=> 'o',

				maxRows		=> 'o',

				style		=> 'o',

				country		=> 'o',

				},

	postalcode_country_info => {

				},

	find_nearby_placename => {

				lat		=> 'r',

				lng		=> 'r',

				radius		=> 'o',

				style		=> 'o',

				maxRows		=> 'o'

				},

	find_nearest_address => {

				lat		=> 'r',

				lng		=> 'r'

				},

	find_nearest_intersection => {

				lat		=> 'r',

				lng		=> 'r'

				},

	find_nearby_streets => {

				lat		=> 'r',

				lng		=> 'r'

				},

	find_nearby_wikipedia => {

				lang		=> 'o',

				lat		=> 'r',

				lng		=> 'r',

				radius		=> 'o',

				maxRows		=> 'o',

				country		=> 'o'

				},

	find_nearby_wikipedia_by_postalcode => {

				postalcode 	=> 'r',

				country		=> 'r',

				radius		=> 'o',

				maxRows		=> 'o'

				},

	wikipedia_search => {

				q		=> 'r',

				lang		=> 'o',

				title		=> 'o',

				maxRows		=> 'o'

				},

	wikipedia_bounding_box => {

				south		=> 'r',

				north		=> 'r',

				east		=> 'r',

				west		=> 'r',

				lang		=> 'o',

				maxRows		=> 'o'

				},

	country_info => {

				country		=> 'o',

				lang		=> 'o'

				},

	country_code => {

				lat		=> 'r',

				lng		=> 'r',

				lang		=> 'o',

				radius		=> 'o'

	},

	find_nearby_weather => {

				lat		=> 'r',

				lng		=> 'r'

	},

	cities => {

        			north           => 'r',

            			south           => 'r',

            			east            => 'r',

           	 		west            => 'r',

            			lang            => 'o',

            			maxRows         => 'o'

	},

   	earthquakes => {

            			north           => 'r',

            			south           => 'r',

            			east            => 'r',

            			west            => 'r',

            			date            => 'o',

            			minMagnutide    => 'o',

            			maxRows         => 'o'

        },

	children => {

				geonameId	=> 'r',

				style		=> 'o'

	}

);



sub new {

    my $class = shift;

    my $self = shift;

    my %hash = @_;



    (exists($hash{url})) ? $self->{url} = $hash{url} : $self->{url} = $GNURL;

    (exists($hash{debug})) ? $DEBUG = $hash{debug} : 0;

    (exists($hash{cache})) ? $CACHE = $hash{cache} : 0;

    $self->{_functions} = \%searches;

    bless $self, $class;

    return $self;

}



sub _build_request {

    my $self = shift;

    my $request = shift;

    my $hash = {@_};

    my $request_string = $GNURL . '/' . $searches{$request};

    # check to see that mandatory arguments are present

    my $conditional_mandatory_flag = 0;

    my $conditional_mandatory_required = 0;

    foreach my $arg (keys %{$valid_parameters{$request}}) {

	my $flags = $valid_parameters{$request}->{$arg};

	if($flags =~ /d/ && exists($hash->{$arg})) {

		carp("Argument $arg is depreciated.");

	}

	$flags =~ s/d//g;

	if($flags eq 'r' && !exists($hash->{$arg})) {

	    carp("Mandatory argument $arg is missing!");

	}

	if($flags eq 'rc') {

	    $conditional_mandatory_required = 1; 

	    if(exists($hash->{$arg})) {

		$conditional_mandatory_flag++;

	    }

	}

    }

    if($conditional_mandatory_required == 1 && $conditional_mandatory_flag != 1) {

	carp("Invalid number of mandatory arguments (there can be only one)");

    }



    foreach my $key (keys(%$hash)) {

	carp("Invalid argument $key") if(!defined($valid_parameters{$request}->{$key}));

	$request_string .= $key . '=' . $hash->{$key} . '&';

    }

    chop($request_string); # loose the trailing &

    return $request_string;

}



sub _parse_xml_result {

    my $self = shift;

    my $geonamesresponse = shift;

    my @result;

    my $xmlsimple = XML::Simple->new();

    my $xml = $xmlsimple->XMLin($geonamesresponse, KeyAttr=>[], ForceArray => 1);



    my $i = 0;

    foreach my $element (keys %{$xml}) {

	if ($element eq 'status') {

	    carp "ERROR: " . $xml->{$element}->[0]->{message};

	}

	next if (ref($xml->{$element}) ne "ARRAY");

	foreach my $list (@{$xml->{$element}}) {

	    next if (ref($list) ne "HASH");

	    foreach my $attribute (%{$list}) {

		next if !defined($list->{$attribute}->[0]);

		$result[$i]->{$attribute} = $list->{$attribute}->[0];

	    }

	    $i++;

	}

    }

    return \@result;

}



sub _parse_json_result {

    my $self = shift;

    my $geonamesresponse = shift;

    my @result;

    my $json = new JSON;

    my $data = $json->decode($geonamesresponse);



    #print STDERR Data::Dumper->Dump([$data]);



    my $i = 0;

    foreach my $hash (keys %{$data}) {

	if(ref($data->{$hash}) eq 'ARRAY') { # we have a list of objects

	    foreach my $object (@{$data->{$hash}}) { # $object is a hash ref

		next if(ref($object) ne 'HASH');

		foreach my $attribute (keys %{$object}) {

		    $result[$i]->{$attribute} = $object->{$attribute};

		}

		$i++;

	    }

	} else { #we have only one

	    my $attributes = $data->{$hash};

	    foreach my $attribute (keys %{$attributes}) {

		$result[$i]->{$attribute} = $attributes->{$attribute};

	    }

	    $i++;

	}

    }

    return \@result;

}



sub _parse_text_result {

    my $self = shift;

    my $geonamesresponse = shift;

    my @result;

    $result[0]->{Result} = $geonamesresponse;

    return \@result;

}



sub _request {

    my $self = shift;

    my $request = shift;

    my $browser = LWP::UserAgent->new;

    $browser->env_proxy();

    my $response = $browser->get($request);

    carp "Can't get $request -- ", $response->status_line unless $response->is_success;

    return ($response->content, $response->header('Content-Type'));

}



sub _do_search {

    my $self = shift;

    my $searchtype = shift;

    my $request = $self->_build_request($searchtype, @_);

    my ($result, $mimetype) = $self->_request($request);

    # check mime-type to determine which parse method to use.

    # we accept text/xml, text/plain (how do see if it is JSON or not?)

    if($mimetype =~ /^text\/xml;/) {

	return($self->_parse_xml_result($result));

    }

    if($mimetype =~ /^application\/json;/) {

	# a JSON object always start with a left-brace {

	# according to http://json.org/	 

	if($result =~ /^\{/) {

	    return($self->_parse_json_result($result));

	} else {

	    return($self->_parse_text_result($result));

	}

    }

    carp "Invalid mime type";

    return undef;

}



sub geocode {

    my $self = shift;

    my $q = shift;

    return($self->search(q=> $q));

}



sub AUTOLOAD {

    my $self = shift;

    my $type = ref($self) || croak "$self is not an object";

    my $name = our $AUTOLOAD;

    $name =~ s/.*://;

    unless (exists $self->{_functions}->{$name}) {

	croak "No such method '$AUTOLOAD'";

    }

    return($self->_do_search($name, @_));

}



sub DESTROY {



}

1;

__END__



=head1 NAME



Geo::GeoNames - Perform geographical queries using GeoNames Web Services



=head1 SYNOPSIS



  use Geo::GeoNames;

  use Data::Dumper;

  my $geo = new Geo::GeoNames();



  # make a query based on placename

  my $result = $geo->search(q => 'Fredrikstad', maxRows => 2);



  # print the first result

  print " Name: " . $result->[0]->{name};

  print " Longitude: " . $result->[0]->{lng};

  print " Lattitude: " . $result->[0]->{lat};



  # Dump the data structure into readable form

  # This also will show the attributes to each found location

  Data::Dumper->Dump()



  # Make a query based on postcode

  $result = $geo->postalcode_search(postalcode => "1630", maxRows => 3, style => "FULL"); 



=head1 DESCRIPTION



Provides a perl interface to the webservices found at 

http://ws.geonames.org. That is, given a given placename or

postalcode, the module will look it up and return more information

(longitude, lattitude, etc) for the given placename or postalcode.

Wikipedia lookups are also supported.

If more than one match is found, a list of locations will be returned.  



=head1 METHODS



=over 4



=item new 



  $geo = Geo::GeoNames->new()

  $geo = Geo::GeoNames->new(url => $url)



Constructor for Geo::GeoNames. It returns a reference to an Geo::GeoNames object.

You may also pass the url of the webservices to use. The default value is

http://ws.geonames.org and is the only url, to my knowledge, that provides

the services needed by this module.



=item geocode($placename)



This function is just an easy access to search. It is the same as saying:



  $geo->search(q => $placename);



=item search(arg => $arg)



Searches for information about a placename. Valid names for B<arg> are as follows: 



  q => $placename

  name => $placename

  name_equals => $placename

  maxRows => $maxrows

  startRow => $startrow

  country => $countrycode

  continentCode => $continentcode

  adminCode1 => $admin1

  adminCode2 => $admin2

  adminCode3 => $admin3

  fclass => $fclass

  featureClass => $fclass,

  featureCode => $code

  lang => $lang

  type => $type

  style => $style

  isNameRequired => $isnamerequired

  tag => $tag



One, and only one, of B<q>, B<name>, or B<name_equals> must be supplied to 

this function.



fclass is depreciated.



For a thorough description of the arguments, see 

http://www.geonames.org/export/geonames-search.html



=item find_nearby_placename(arg => $arg)



Reverse lookup for closest placename to a given coordinate. Valid names for

B<arg> are as follows:



  lat => $lat

  lng => $lng

  radius => $radius

  style => $style

  maxRows => $maxrows



Both B<lat> and B<lng> must be supplied to 

this function.



For a thorough descriptions of the arguments, see 

http://www.geonames.org/export



=item find_nearest_address(arg => $arg)



Reverse lookup for closest address to a given coordinate. Valid names for

B<arg> are as follows:



  lat => $lat

  lng => $lng



Both B<lat> and B<lng> must be supplied to 

this function.



For a thorough descriptions of the arguments, see 

http://www.geonames.org/maps/reverse-geocoder.html



US only.



=item find_nearest_intersection(arg => $arg)



Reverse lookup for closest intersection to a given coordinate. Valid names for

B<arg> are as follows:



  lat => $lat

  lng => $lng



Both B<lat> and B<lng> must be supplied to 

this function.



For a thorough descriptions of the arguments, see 

http://www.geonames.org/maps/reverse-geocoder.html



US only.



=item find_nearby_streets(arg => $arg)



Reverse lookup for closest streets to a given coordinate. Valid names for

B<arg> are as follows:



  lat => $lat

  lng => $lng



Both B<lat> and B<lng> must be supplied to 

this function.



For a thorough descriptions of the arguments, see 

http://www.geonames.org/maps/reverse-geocoder.html



US only.



=item postalcode_search(arg => $arg)



Searches for information about a postalcode. Valid names for B<arg> are as follows: 



  postalcode => $postalcode

  placename => $placename

  country => $country

  maxRows => $maxrows

  style => $style



One, and only one, of B<postalcode> or B<placename> must be supplied to 

this function.



For a thorough description of the arguments, see 

http://www.geonames.org/export



=item find_nearby_postalcodes(arg => $arg)



Reverse lookup for postalcodes. Valid names for B<arg> are as follows:



  lat => $lat

  lng => $lng

  radius => $radius

  maxRows => $maxrows

  style => $style

  country => $country



Both B<lat> and B<lng> must be supplied to 

this function.



For a thorough description of the arguments, see 

http://www.geonames.org/export



=item postalcode_country_info



Returns a list of all postalcodes found on GeoNames. This function

takes no arguments.



=item country_info(arg => $arg)



Returns country information. Valid names for B<arg> are as follows:



  country => $country

  lang => $lang



For a thorough description of the arguments, see 

http://www.geonames.org/export



=item find_nearby_wikipedia(arg => $arg)



Reverse lookup for Wikipedia articles. Valid names for B<arg> are as follows:



  lat => $lat

  lng => $lng

  radius => $radius

  maxRows => $maxrows

  lang => $lang

  country => $country



Both B<lat> and B<lng> must be supplied to 

this function.



For a thorough description of the arguments, see 

http://www.geonames.org/export



=item find_nearby_wikipediaby_postalcode(arg => $arg)



Reverse lookup for Wikipedia articles. Valid names for B<arg> are as follows:



  postalcode => $postalcode

  country => $country

  radius => $radius

  maxRows => $maxrows



Both B<postalcode> and B<country> must be supplied to 

this function.



For a thorough description of the arguments, see 

http://www.geonames.org/export



=item wikipedia_search(arg => $arg)



Searches for Wikipedia articles. Valid names for B<arg> are as follows:



  q => $placename

  maxRows => $maxrows

  lang => $lang

  title => $title



B<q> must be supplied to 

this function.



For a thorough description of the arguments, see 

http://www.geonames.org/export



=item wikipedia_bounding_box(arg => $arg)



Searches for Wikipedia articles. Valid names for B<arg> are as follows:



  south => $south

  north => $north

  east => $east

  west => $west

  lang => $lang

  maxRows => $maxrows



B<south>, B<north>, B<east>, and B<west> and must be supplied to 

this function.



For a thorough description of the arguments, see 

http://www.geonames.org/export



=item cities(arg => $arg)



Returns a list of cities and placenames within the bounding box. 

Valid names for B<arg> are as follows:



  south => $south

  north => $north

  east => $east

  west => $west

  lang => $lang

  maxRows => $maxrows



B<south>, B<north>, B<east>, and B<west> and must be supplied to 

this function.



For a thorough description of the arguments, see 

http://www.geonames.org/export



=item country_code(arg => $arg)



Return the country code for a given point. Valid names for B<arg> are as follows:



  lat => $lat

  lng => $lng

  radius => $radius

  lang => $lang



Both B<lat> and B<lng> must be supplied to 

this function.



For a thorough description of the arguments, see 

http://www.geonames.org/export



=item earthquakes(arg => $arg)



Returns a list of cities and placenames within the bounding box. 

Valid names for B<arg> are as follows:



  south => $south

  north => $north

  east => $east

  west => $west

  date => $date

  minMagnitude => $minmagnitude

  maxRows => $maxrows



B<south>, B<north>, B<east>, and B<west> and must be supplied to 

this function.



For a thorough description of the arguments, see 

http://www.geonames.org/export



=item find_nearby_weather(arg => $arg)



Return the country code for a given point. Valid names for B<arg> are as follows:



  lat => $lat

  lng => $lng



Both B<lat> and B<lng> must be supplied to 

this function.



For a thorough description of the arguments, see 

http://www.geonames.org/export



=back



=head1 RETURNED DATASTRUCTURE



The datastructure returned from methods in this module is an array of

hashes. Each array element contains a hash which in turn contains the information

about the placename/postalcode.



For example, running the statement



  my $result = $geo->search(q => "Fredrikstad", maxRows => 3, style => "FULL");



yields the result (after doing a Data::Dumper->Dump($result);):



  $VAR1 = {

           'population' => {},

           'lat' => '59.2166667',

           'elevation' => {},

           'countryCode' => 'NO',

           'adminName1' => "\x{d8}stfold",

           'fclName' => 'city, village,...',

           'adminCode2' => {},

           'lng' => '10.95',

           'geonameId' => '3156529',

           'timezone' => {

                         'dstOffset' => '2.0',

                         'content' => 'Europe/Oslo',

                         'gmtOffset' => '1.0'

                       },

           'fcode' => 'PPL',

           'countryName' => 'Norway',

           'name' => 'Fredrikstad',

           'fcodeName' => 'populated place',

           'alternateNames' => 'Frederikstad,Fredrikstad,Fredrikstad kommun',

           'adminCode1' => '13',

           'adminName2' => {},

           'fcl' => 'P'

         };



The elements in the hashes depends on which B<style> is passed to the method, but

will always contain B<name>, B<lng>, and B<lat> except for postalcode_country_info(),

find_nearest_address(), find_nearest_intersection(), and find_nearby_streets().



=head1 BUGS



Not a bug, but the GeoNames services expects placenames to be

UTF-8 encoded, and all data recieved from the webservices are

also UTF-8 encoded. So make sure that strings are encoded/decoded

based on the correct encoding.



Please report any bugs found or feature requests to

http://code.google.com/p/geo-geonames/issues/list



=head1 SEE ALSO



http://www.geonames.org/export

http://www.geonames.org/export/ws-overview.html



=head1 SOURCE AVAILABILITY



The source code for this module is available from SVN

at http://code.google.com/p/geo-geonames



=head1 AUTHOR



Per Henrik Johansen, E<lt>per.henrik.johansen@gmail.comE<gt>



=head1 COPYRIGHT AND LICENSE



Copyright (C) 2007-2008 by Per Henrik Johansen



This library is free software; you can redistribute it and/or modify

it under the same terms as Perl itself, either Perl version 5.8.8 or,

at your option, any later version of Perl 5 you may have available.





=cut