File Coverage

blib/lib/Geo/Coder/GoogleMaps/Location.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Geo::Coder::GoogleMaps::Location ;

use strict;
use warnings;
use strict;
use Carp;
use JSON::Syck;
use XML::LibXML;

our $VERSION='0.4';

=encoding utf-8

=head1 NAME

Geo::Coder::GoogleMaps::Location - Geo::Coder::GoogleMaps' Location object

=head1 VERSION

Version 0.4 (follow L version number)

=head1 SYNOPSIS

Here we have the object returned by L->placemarks().

This object can generate and manipulate the geocoding subset of KML 2.2 object (main change for the geocoding feature is the introduction of ExtendedData).

=head1 FUNCTIONS

=head2 new

The constructor can take the following arguments :

	- SubAdministrativeAreaName : a string
	- PostalCodeNumber : a postal code (err...)
	- LocalityName : yes! A locality name !
	- ThoroughfareName: same thing => a string
	- AdministrativeAreaName
	- CountryName
	- CountryNameCode
	- address
	- longitude
	- latitude
	- altitude (warning in Google Maps API altitude must be 0)

=cut

sub new {
	my($class, %param) = @_;
	my $obj = {
		'AddressDetails' => {
			'Country' => {
				'AdministrativeArea' => {
					'SubAdministrativeArea' => {
						'SubAdministrativeAreaName' => delete $param{'SubAdministrativeAreaName'} || '',
						'Locality' => {
							'PostalCode' => {
								'PostalCodeNumber' => delete $param{'PostalCodeNumber'} || ''
							},
							'LocalityName' => delete $param{'LocalityName'} || '',
							'Thoroughfare' => {
								'ThoroughfareName' => delete $param{'ThoroughfareName'} || ''
							}
						}
					},
					'AdministrativeAreaName' => delete $param{'AdministrativeAreaName'} || ''
				},
				'CountryNameCode' => delete $param{'CountryNameCode'} || '',
				'CountryName' => delete $param{'CountryName'} || ''
			}
		},
		'address' => delete $param{'address'} || '',
		'Point' => {
			'coordinates' => [
				delete $param{'longitude'} || '',
				delete $param{'latitude'} || '',
				delete $param{'altitude'} || 0
			]
		}
	};
	my $out = delete $param{'output'} || 'json';
	bless { data => $obj, output => $out }, $class;
}

=head2 SubAdministrativeAreaName

Access the SubAdministrativeAreaName parameter.

	print $location->SubAdministrativeAreaName(); # retrieve the value
	$location->SubAdministrativeAreaName("Paris"); # set the value

=cut

sub SubAdministrativeAreaName {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'AddressDetails'}->{'Country'}->{'AdministrativeArea'}->{'SubAdministrativeArea'}->{'SubAdministrativeAreaName'}=$data : $self->{data}->{'AddressDetails'}->{'Country'}->{'AdministrativeArea'}->{'SubAdministrativeArea'}->{'SubAdministrativeAreaName'} ;
}

=head2 PostalCodeNumber

Access the PostalCodeNumber parameter.

	print $location->PostalCodeNumber(); # retrieve the value
	$location->PostalCodeNumber("75000"); # set the value

=cut

sub PostalCodeNumber {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'AddressDetails'}->{'Country'}->{'AdministrativeArea'}->{'SubAdministrativeArea'}->{'Locality'}->{'PostalCode'}->{'PostalCodeNumber'}=$data : $self->{data}->{'AddressDetails'}->{'Country'}->{'AdministrativeArea'}->{'SubAdministrativeArea'}->{'Locality'}->{'PostalCode'}->{'PostalCodeNumber'} ;
}

=head2 ThoroughfareName

Access the ThoroughfareName parameter.

	print $location->ThoroughfareName(); # retrieve the value
	$location->ThoroughfareName("1 Avenue des Champs Élysées"); # set the value

=cut

sub ThoroughfareName {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'AddressDetails'}->{'Country'}->{'AdministrativeArea'}->{'SubAdministrativeArea'}->{'Locality'}->{'Thoroughfare'}->{'ThoroughfareName'}=$data : $self->{data}->{'AddressDetails'}->{'Country'}->{'AdministrativeArea'}->{'SubAdministrativeArea'}->{'Locality'}->{'Thoroughfare'}->{'ThoroughfareName'} ;
}

=head2 LocalityName

Access the LocalityName parameter.

	print $location->LocalityName(); # retrieve the value
	$location->LocalityName("Paris"); # set the value

=cut

sub LocalityName {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'AddressDetails'}->{'Country'}->{'AdministrativeArea'}->{'SubAdministrativeArea'}->{'Locality'}->{'LocalityName'}=$data : $self->{data}->{'AddressDetails'}->{'Country'}->{'AdministrativeArea'}->{'SubAdministrativeArea'}->{'Locality'}->{'LocalityName'} ;
}

=head2 AdministrativeAreaName

Access the AdministrativeAreaName parameter.

	print $location->AdministrativeAreaName(); # retrieve the value
	$location->AdministrativeAreaName("PA"); # set the value

=cut

sub AdministrativeAreaName {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'AddressDetails'}->{'Country'}->{'AdministrativeArea'}->{'AdministrativeAreaName'}=$data : $self->{data}->{'AddressDetails'}->{'Country'}->{'AdministrativeArea'}->{'AdministrativeAreaName'} ;
}

=head2 CountryName

Access the CountryName parameter.

	print $location->CountryName(); # retrieve the value
	$location->CountryName("France"); # set the value

=cut

sub CountryName {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'AddressDetails'}->{'Country'}->{'CountryName'}=$data : $self->{data}->{'AddressDetails'}->{'Country'}->{'CountryName'} ;
}

=head2 CountryNameCode

Access the CountryNameCode parameter.

	print $location->CountryNameCode(); # retrieve the value
	$location->CountryNameCode("FR"); # set the value

=cut

sub CountryNameCode {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'AddressDetails'}->{'Country'}->{'CountryNameCode'}=$data : $self->{data}->{'AddressDetails'}->{'Country'}->{'CountryNameCode'} ;
}

=head2 Accuracy

Access the Accuracy parameter.

	print $location->Accuracy(); # retrieve the value
	$location->Accuracy(8); # set the value

=cut

sub Accuracy {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'AddressDetails'}->{'Accuracy'}=$data : $self->{data}->{'AddressDetails'}->{'Accuracy'} ;
}

=head2 address

Access the address parameter.

	print $location->address(); # retrieve the value
	$location->address("1 Avenue des Champs Élysées, 75000, Paris, FR"); # set the value

=cut

sub address {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'address'}=$data : $self->{data}->{'address'} ;
}

=head2 id

Access the id parameter.

	print $location->id(); # retrieve the value
	$location->id("point1"); # set the value

=cut

sub id {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'id'}=$data : $self->{data}->{'id'} ;
}

=head2 latitude

Access the latitude parameter.

	print $location->latitude(); # retrieve the value
	$location->latitude("-122.4558"); # set the value

=cut

sub latitude {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'Point'}->{'coordinates'}->[1]=$data : $self->{data}->{'Point'}->{'coordinates'}->[1] ;
}


=head2 longitude

Access the longitude parameter.

	print $location->longitude(); # retrieve the value
	$location->longitude("55.23465"); # set the value

=cut

sub longitude {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'Point'}->{'coordinates'}->[0]=$data : $self->{data}->{'Point'}->{'coordinates'}->[0] ;
}

=head2 altitude

Access the altitude parameter.

	print $location->altitude(); # retrieve the value
	$location->altitude(0); # set the value

Please note that it must be 0 if you use the Google Map API.

=cut

sub altitude {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'Point'}->{'coordinates'}->[2]=$data : $self->{data}->{'Point'}->{'coordinates'}->[2] ;
}

=head2 coordinates

This method is not really an accessor, it's only a getter which return longitude, latitude and altitude as a string.

	print "Placemark's coordinates: ",$location->coordinates,"\n";

=cut

sub coordinates {
	my $self = shift;
	return $self->longitude().','.$self->latitude().','.$self->altitude ;
}

=head2 LLB_north

Access the north parameter from the LatLonBox.

	print $location->LLB_north(); # retrieve the value
	$location->LLB_north(48.9157461); # set the value

=cut

sub LLB_north {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'ExtendedData'}->{'LatLonBox'}->{'north'}=$data : $self->{data}->{'ExtendedData'}->{'LatLonBox'}->{'north'} ;
}

=head2 LLB_south

Access the south parameter from the LatLonBox.

	print $location->LLB_south(); # retrieve the value
	$location->LLB_south(48.9157461); # set the value

=cut

sub LLB_south {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'ExtendedData'}->{'LatLonBox'}->{'south'}=$data : $self->{data}->{'ExtendedData'}->{'LatLonBox'}->{'south'} ;
}

=head2 LLB_east

Access the east parameter from the LatLonBox.

	print $location->LLB_east(); # retrieve the value
	$location->LLB_east(48.9157461); # set the value

=cut

sub LLB_east {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'ExtendedData'}->{'LatLonBox'}->{'east'}=$data : $self->{data}->{'ExtendedData'}->{'LatLonBox'}->{'east'} ;
}

=head2 LLB_west

Access the west parameter from the LatLonBox.

	print $location->LLB_west(); # retrieve the value
	$location->LLB_west(48.9157461); # set the value

=cut

sub LLB_west {
	my ($self,$data) = @_ ;
	return $data ? $self->{data}->{'ExtendedData'}->{'LatLonBox'}->{'west'}=$data : $self->{data}->{'ExtendedData'}->{'LatLonBox'}->{'west'} ;
}

=head2 toJSON

Return a JSON encoded object ( thanks to JSON::Syck::Dump() )

	my $json = $location->toJSON ;

=cut

sub toJSON {
	my $self = shift;
	return JSON::Syck::Dump($self->{'data'}) ;
}

=head2 toKML

Return a KML object ( thanks to XML::LibXML ).

	my $kml = $location->toXML ;

Please note that this function can take an optionnal argument (0 or 1) and if it's set to 1 this method return a XML string instead of the XML::LibXML::Document object.

=cut

sub toKML {
	sub _toKMLinternal {
		my $self = shift;
		my $document = shift;
		my $xml_element = shift;
		my $root = shift;
		return unless($root);
		return unless( ref($root) eq "HASH" );
# 		print "[debug] _toKMLinternal() \$root=$root\n";
		foreach my $key (keys(%{$root})){
			next if($key eq "Accuracy");
# 			print "[debug] _toKMLinternal() creating new element: $key\n";
			my $new_element = $document->createElement($key);
			if( $self->can($key) ){
				if(defined($self->$key)){
					$new_element->appendText($self->$key);
					$xml_element->appendChild($new_element);
				}
			}
			else{
				if($key eq 'AddressDetails'){
					$new_element->setNamespace("urn:oasis:names:tc:ciq:xsdschema:xAL:2.0", '',0);
					$new_element->setAttribute('Accuracy',$self->Accuracy);
				}
				elsif( $key eq 'LatLonBox' ){
					$new_element->setAttribute('north',$root->{$key}->{north});
					$new_element->setAttribute('south',$root->{$key}->{south});
					$new_element->setAttribute('east',$root->{$key}->{east});
					$new_element->setAttribute('west',$root->{$key}->{west});
				}
				$xml_element->appendChild($new_element);
				_toKMLinternal($self,$document,$new_element,$root->{$key}) unless($key eq 'LatLonBox');
			}
		}
	}

	my $self = shift;
	my $as_string = shift;
	my $document = XML::LibXML::Document->createDocument( "1.0", "UTF-8" );
	$document->setStandalone(1);
	my $kml = $document->createElement('kml');
# 	$kml->setNamespace("http://earth.google.com/kml/2.1", '',0);
	$kml->setNamespace("http://www.opengis.net/kml/2.2", '',0);
	$document->setDocumentElement($kml);
	my $placemark = $document->createElement('Placemark');
	$placemark->setAttribute('id',$self->id);
	$kml->appendChild($placemark);
	my $data = {%{$self->{data}}};
	delete($data->{id});
# 	delete($data->{AddressDetails}->{Accuracy});
	_toKMLinternal($self,$document,$placemark,$data);
	$document->setEncoding("UTF-8");
	return $document->toString(1) if($as_string);
	return $document;
}

=head2 toXML

An allias for toKML()

=cut

sub toXML {
	return shift->toKML(@_);
}

=head2 Serialize

This method simply call the good to(JSON|XML|KML) depending of the output format you selected.

You can eventually pass extra arguments, they will be relayed.

	$location->Serialize(1); # if the output is set to XML or KML you will have a stringified XML as output

=cut

sub Serialize {
	my $self = shift;
	if($self->{output}){
		return $self->toJSON if($self->{output} eq 'json');
		return $self->toKML(@_) if($self->{output} eq 'xml' or $self->{output} eq 'kml');
		return $self->toJSON ;
	}
	else {
		return $self->toJSON ;
	}
}

=head2 Serialyze (OBSOLETE)

This method is just an alias to Serialize(), it is kept for backward compatibility only.

Please use the Serialize() method, this one is meant to be removed.

=cut

sub Serialyze {
	return Serialize(@_);
}

sub _setData {
	my ($self,$data)=@_;
	$self->{data}=$data;
}

=head1 AUTHOR

Arnaud Dupuis, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Geo::Coder::GoogleMaps::Location

You can also look for information at:

=over 4

=item * Infinity Perl:

L

=item * Google Code repository

L

=item * Google Maps API documentation

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * RT: CPAN's request tracker

L

=item * Search CPAN

L

=back

=head1 ACKNOWLEDGEMENTS

Slaven Rezic (L) for all the patches and his useful reports on RT.

=head1 COPYRIGHT & LICENSE

Copyright 2007 Arnaud DUPUIS and Nabla Development, all rights reserved.

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

=cut
1; # end of Geo::Coder::GoogleMaps::Location