line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Geo::Query::LatLong; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
############################################################ |
4
|
|
|
|
|
|
|
# Geo::Query::LatLong |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Author: Reto Schaer |
7
|
|
|
|
|
|
|
# Copyright (c) 2007 - 2008 |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# http://meta.pgate.net/geo-query-latlong/ |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
our $VERSION = '0.8011'; |
12
|
|
|
|
|
|
|
############################################################ |
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
27535
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
44
|
|
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
3450
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
59175
|
|
|
1
|
|
|
|
|
28
|
|
17
|
1
|
|
|
1
|
|
777
|
use HTTP::Request::Common; |
|
1
|
|
|
|
|
1867
|
|
|
1
|
|
|
|
|
1014
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# GLOBAL VARIABLES |
20
|
|
|
|
|
|
|
my $package = __PACKAGE__; |
21
|
|
|
|
|
|
|
my %Var = (); |
22
|
|
|
|
|
|
|
my $contentType = ""; |
23
|
|
|
|
|
|
|
my $ua; |
24
|
|
|
|
|
|
|
$| = 1; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
#----- FORWARD DECLARATIONS & PROTOTYPING |
27
|
|
|
|
|
|
|
sub Debug($); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub new { |
30
|
0
|
|
|
0
|
0
|
|
my $type = shift; |
31
|
0
|
|
|
|
|
|
my %params = @_; |
32
|
0
|
|
|
|
|
|
my $self = {}; |
33
|
0
|
|
|
|
|
|
$self->{'debug' } = $params{'debug' }; |
34
|
0
|
|
0
|
|
|
|
$self->{'source'} = $params{'source'} || 'geo'.'111'; |
35
|
0
|
0
|
|
|
|
|
Debug "$package V$VERSION" if $self->{'debug'}; |
36
|
0
|
|
|
|
|
|
$ua = LWP::UserAgent->new( agent => "Geo::Query::LatLong $VERSION" ); |
37
|
|
|
|
|
|
|
|
38
|
0
|
|
|
|
|
|
$Var{'source'} = 'geo'.'111'; |
39
|
0
|
0
|
|
|
|
|
if ($self->{'source'} eq 'Google') { |
40
|
0
|
|
0
|
|
|
|
$self->{'apikey'} = $params{'apikey'} || ''; |
41
|
0
|
0
|
|
|
|
|
unless ($self->{'apikey'}) { |
42
|
0
|
|
|
|
|
|
print STDERR "ERR: apikey required.\n"; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
else { |
45
|
|
|
|
|
|
|
# Everything looks good so far |
46
|
0
|
|
|
|
|
|
$Var{'source'} = 'Google'; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
0
|
|
|
|
|
|
bless $self, $type; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub query { |
54
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
55
|
0
|
|
|
|
|
|
my %args = @_; |
56
|
|
|
|
|
|
|
|
57
|
0
|
|
0
|
|
|
|
$args{'country_code'} ||= 'SZ'; # FIPS 10 |
58
|
0
|
|
0
|
|
|
|
$args{'city' } ||= '' ; # e.g. Zurich |
59
|
0
|
|
0
|
|
|
|
$args{'exact' } ||= 'on'; |
60
|
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
|
my %res_hash = (); |
62
|
0
|
|
|
|
|
|
$res_hash{'rc'} = 0; |
63
|
0
|
|
|
|
|
|
$res_hash{'lat'} = $res_hash{'lng'} = 99; # init |
64
|
0
|
|
|
|
|
|
$res_hash{'source'} = $Var{'source'}; |
65
|
|
|
|
|
|
|
|
66
|
0
|
0
|
|
|
|
|
if ($self->{'debug'}) { Debug "$_ = $args{$_}" foreach keys %args; } |
|
0
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
0
|
0
|
|
|
|
|
if ($Var{'source'} eq 'Google') { |
69
|
0
|
0
|
|
|
|
|
Debug 'Google API query.' if $self->{'debug'}; |
70
|
0
|
|
|
|
|
|
my $location = &google_query($self, location => $args{'city'} ); |
71
|
0
|
|
|
|
|
|
my @point = (); |
72
|
0
|
0
|
|
|
|
|
if (defined @{$location->{'Point'}->{'coordinates'}}) { |
|
0
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
|
$res_hash{'address'} = $location->{'address'}; |
74
|
0
|
|
|
|
|
|
@point = @{$location->{'Point'}->{'coordinates'}}; |
|
0
|
|
|
|
|
|
|
75
|
0
|
|
|
|
|
|
$res_hash{'lng'} = $point[0]; |
76
|
0
|
|
|
|
|
|
$res_hash{'lat'} = $point[1]; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
else { |
80
|
0
|
|
|
|
|
|
my $url = 'http://geo.pg' . 'ate.net/query/'; |
81
|
0
|
|
|
|
|
|
my $r = HTTP::Request->new('GET', $url . |
82
|
|
|
|
|
|
|
"?city=$args{'city'}&country_code=$args{'country_code'}&exact=$args{'exact'}"); |
83
|
0
|
|
|
|
|
|
my $resp = $ua->request($r); |
84
|
|
|
|
|
|
|
|
85
|
0
|
0
|
|
|
|
|
if ($resp->is_success) { |
86
|
0
|
|
|
|
|
|
my @lines = split /\n/, $resp->content(); |
87
|
0
|
|
|
|
|
|
my $result = ''; |
88
|
0
|
|
|
|
|
|
foreach (@lines) { |
89
|
0
|
|
|
|
|
|
my ($key, $val) = split /\t/; |
90
|
0
|
|
|
|
|
|
$res_hash{$key} = $val; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
|
\%res_hash; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub google_query(%) { |
99
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
100
|
0
|
|
|
|
|
|
my %args = @_; |
101
|
0
|
|
0
|
|
|
|
$args{'location'} ||= ''; |
102
|
|
|
|
|
|
|
|
103
|
0
|
0
|
|
|
|
|
eval 'use JSON::Syck; 1' or print STDERR "ERR JSON::Syck is missing\n"; |
104
|
1
|
|
|
1
|
|
1089
|
use Encode; |
|
1
|
|
|
|
|
12350
|
|
|
1
|
|
|
|
|
361
|
|
105
|
|
|
|
|
|
|
# use URI; |
106
|
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
my $uri = URI->new("http://maps.google.com/maps/geo"); |
108
|
0
|
|
|
|
|
|
$uri->query_form(q => $args{'location'}, output => 'json', key => $self->{'apikey'}); |
109
|
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
my $res = $ua->get($uri); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# Content-Type: text/javascript; charset=UTF-8; charset=Shift_JIS |
113
|
0
|
|
|
|
|
|
my @ctype = $res->content_type; |
114
|
0
|
|
0
|
|
|
|
my $charset = ($ctype[1] =~ /charset=([\w\-]+)$/)[0] || "utf-8"; # Thanks to Tatsuhiko Miyagawa from Geo-Coder-Google |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
my $content = Encode::decode($charset, $res->content); |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
local $JSON::Syck::ImplicitUnicode = 1; |
119
|
0
|
0
|
|
|
|
|
1 if defined $JSON::Syck::ImplicitUnicode; # prevent warning |
120
|
0
|
|
|
|
|
|
my $data = JSON::Syck::Load($content); |
121
|
|
|
|
|
|
|
|
122
|
0
|
0
|
|
|
|
|
my @placemark = @{ $data->{Placemark} || [] }; |
|
0
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
0
|
0
|
|
|
|
|
wantarray ? @placemark : $placemark[0]; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
0
|
|
|
0
|
0
|
|
sub Debug ($) { print "[ $package ] $_[0]\n"; } |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
#### Used Warning / Error Codes ########################## |
130
|
|
|
|
|
|
|
# Next free W Code: 1000 |
131
|
|
|
|
|
|
|
# Next free E Code: 1000 |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
#### Var |
134
|
|
|
|
|
|
|
# - source: geo.111 || Google |
135
|
|
|
|
|
|
|
# - Google_h |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
1; |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
__END__ |