/lib/Geo/GeoNames.pm
Perl | 737 lines | 713 code | 16 blank | 8 comment | 18 complexity | a8a49a3dad59318a56e44d09ef95f541 MD5 | raw file
- # $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