File Coverage

blib/lib/Geo/Coder/HostIP.pm
Criterion Covered Total %
statement 14 117 11.9
branch 0 60 0.0
condition 0 48 0.0
subroutine 5 22 22.7
pod 13 15 86.6
total 32 262 12.2


line stmt bran cond sub pod time code
1             package Geo::Coder::HostIP;
2              
3 1     1   58825 use 5.006;
  1         3  
4 1     1   4 use strict;
  1         2  
  1         15  
5 1     1   4 use warnings;
  1         1  
  1         29  
6 1     1   10 use Carp;
  1         3  
  1         46  
7              
8 1     1   594 use LWP::UserAgent;
  1         39952  
  1         1150  
9              
10             our $VERSION = '0.07';
11              
12             sub new {
13 0     0 1   my $c = shift;
14 0   0       my $pkg = ref $c || $c;
15 0           my $obj = {};
16 0           bless $obj, $pkg;
17 0   0       my $server = shift || 'api.hostip.info';
18 0           $obj->{_server} = $server;
19 0           $obj->{_ua} = LWP::UserAgent->new;
20 0           $obj->{_agent} = 'Geo::Coder::HostIP/0.1';
21 0           return $obj;
22             }
23              
24             sub Agent {
25 0     0 1   my $obj = shift;
26 0 0         my $uaname = shift or return undef;
27 0           $obj->{_agent} = $uaname;
28             }
29              
30             sub _request {
31 0     0     my $obj = shift;
32 0           $obj->{_ua}->agent($obj->{_agent});
33 0 0 0       return undef unless $obj->{_server} and $obj->{ip};
34              
35 0           my $res = $obj->{_ua}->get("http://$obj->{_server}/get_html.php?".
36             "ip=$obj->{ip}&position=true");
37              
38 0 0         if ($res->is_success) {
39 0           return $obj->_parse($res->content);
40             }
41             else {
42 0           croak $res->status_line;
43             }
44             }
45              
46             sub FetchIP {
47 0     0 1   my $obj = shift;
48 0 0         my $ip = shift or return undef;
49 0           $obj->{ip} = $ip;
50 0           return $obj->_request;
51             }
52              
53             sub FetchName {
54 0     0 1   my $obj = shift;
55 0 0         my $name = shift or return undef;
56 0           my $ip = join ".", unpack('C4', (gethostbyname $obj->{domain})[4]);
57 0           return $obj->FetchIP($obj->{domain});
58             }
59              
60             sub FetchRemoteAddr {
61 0     0 1   my $obj = shift;
62 0 0 0       if (exists $ENV{REMOTE_ADDR} && defined $ENV{REMOTE_ADDR}) {
63 0           return $obj->FetchIP($ENV{REMOTE_ADDR});
64             }
65             else {
66 0           return undef;
67             }
68             }
69              
70             sub Lat {
71 0     0 1   my $obj = shift;
72 0 0         return exists $obj->{Latitude} ? $obj->{Latitude} : undef;
73             }
74              
75             sub Long {
76 0     0 1   my $obj = shift;
77 0 0         return exists $obj->{Longitude} ? $obj->{Longitude} : undef;
78             }
79              
80             sub Latitude {
81 0     0 1   my $obj = shift;
82 0           return $obj->Lat;
83             }
84              
85             sub Longitude {
86 0     0 1   my $obj = shift;
87 0           return $obj->Long;
88             }
89              
90             sub City {
91 0     0 1   my $obj = shift;
92 0 0         return exists $obj->{City} ? $obj->{City} : undef;
93             }
94              
95             sub Country {
96 0     0 1   my $obj = shift;
97 0 0         return exists $obj->{Country} ? $obj->{Country} : undef;
98             }
99              
100             sub CountryCode {
101 0     0 1   my $obj = shift;
102 0 0         return exists $obj->{Country_Code} ? $obj->{Country_Code} : undef;
103             }
104              
105             sub State {
106 0     0 1   my $obj = shift;
107 0 0         return exists $obj->{State} ? $obj->{State} : undef;
108             }
109              
110             sub Coords {
111 0     0 0   my $obj = shift;
112 0 0 0       if (exists $obj->{Latitude} and exists $obj->{Longitude}) {
113 0 0         return wantarray ? ($obj->{Latitude}, $obj->{Longitude}) :
114             "Lat: $obj->{Latitude}, Long: $obj->{Longitude}";
115             }
116             else {
117 0           return undef;
118             }
119             }
120              
121             sub GoogleMap {
122 0     0 0   my $obj = shift;
123 0           my $params = pop;
124              
125 0 0         if (@_) {
126 0           my $ip = shift;
127 0           $obj->FetchIP($ip);
128             }
129              
130 0 0 0       unless ( exists $obj->{Latitude} and defined $obj->{Latitude}
      0        
      0        
      0        
      0        
131             and exists $obj->{Longitude} and defined $obj->{Longitude}
132             and ref $params eq 'HASH' and $params->{apikey}) {
133 0           return undef;
134             }
135              
136 0           my $apikey = $params->{apikey};
137 0   0       my $id = $params->{id} || 'googlemap';
138 0   0       my $fname = $params->{func_name} || 'load';
139 0   0       my $width = $params->{width} || 500;
140 0   0       my $height = $params->{height} || 300;
141 0   0       my $zoom = $params->{zoom} || 13;
142              
143 0           my $controls = '';
144 0 0         if ($params->{control}) {
145 0 0         if ($params->{control} eq 'large') {
    0          
146 0           $controls = 'map.addControl(new GLargeMapControl());';
147             }
148             elsif ($params->{control} eq 'small') {
149 0           $controls = 'map.addControl(new GSmallMapControl());';
150             }
151             else {
152 0           $controls = 'map.addControl(new GSmallScaleControl());';
153             }
154             }
155              
156 0           my $scalec = '';
157 0 0         if ($params->{scalecontrol}) {
158 0           $scalec = 'map.addControl(new GScaleControl());';
159             }
160              
161 0           my $typec = '';
162 0 0         if ($params->{typecontrol}) {
163 0           $typec = 'map.addControl(new GMapTypeControl());';
164             }
165            
166 0           my $overc = '';
167 0 0         if ($params->{overviewcontrol}) {
168 0           $overc = 'map.addControl(new GOverviewMapControl());';
169             }
170              
171 0           my $lat = $obj->{Latitude} + 0;
172 0           my $long = $obj->{Longitude} + 0;
173              
174 0           return <<"EOF";
175            
176            
177            
179            
196            
197            
198            
199            
200            
201            
202            
203             EOF
204             }
205              
206             sub _parse {
207 0     0     my $obj = shift;
208 0 0         my $res = shift or return undef;
209              
210 0           for my $key (qw(Country City Longitude Latitude)) {
211 0           delete $obj->{$key};
212             }
213              
214 0           my $content = $res;
215 0           my @rows = split /[\r\n]+/, $content;
216 0           chomp @rows;
217              
218 0           for my $row (@rows) {
219 0           my ($k, $v) = split /\s*:\s*/, $row, 2;
220 0 0 0       if ($k eq 'Country') {
    0          
    0          
221 0           $v =~ /(.*)\s*\(([^\)]+)\)$/;
222 0           $obj->{Country} = $1;
223 0           $obj->{Country_Code} = $2;
224             }
225             elsif ($k eq 'City') {
226 0 0         if ($v =~ /(.*),\s+([A-Z]+)/) {
227 0           $obj->{City} = $1;
228 0           $obj->{State} = $2;
229             }
230             }
231             elsif ($k eq 'Latitude' or $k eq 'Longitude') {
232 0           $obj->{$k} = $v + 0;
233             }
234             else {
235 0   0       $obj->{$k} ||= $v;
236             }
237             }
238 0 0 0       if (defined $obj->{Latitude} and defined $obj->{Longitude}) {
239 0 0         return wantarray ? ($obj->{Latitude}, $obj->{Longitude}) :
240             "Lat: $obj->{Latitude}, Long: $obj->{Longitude}";
241             }
242             else {
243 0 0         return wantarray ? () : 'Coordinates Not Found';
244             }
245             }
246              
247             1;
248              
249             __END__