File Coverage

blib/lib/Net/ModestMaps.pm
Criterion Covered Total %
statement 18 75 24.0
branch 0 18 0.0
condition 0 6 0.0
subroutine 6 11 54.5
pod 4 5 80.0
total 28 115 24.3


line stmt bran cond sub pod time code
1 1     1   1455 use strict;
  1         2  
  1         88  
2              
3             # $Id: ModestMaps.pm,v 1.9 2008/07/24 06:05:16 asc Exp $
4              
5             package Net::ModestMaps;
6 1     1   6 use base qw(LWP::UserAgent);
  1         2  
  1         1123  
7              
8             $Net::ModestMaps::VERSION = '1.1';
9              
10             =head1 NAME
11              
12             Net::ModestMaps - Simple OOP wrapper for calling ModestMaps web services.
13              
14             =head1 SYNOPSIS
15              
16             my %args = (
17             'provider' => 'MICROSOFT_ROAD',
18             'method' => 'center',
19             'latitude' => '45.521375561025756',
20             'longitude' => '-73.57049345970154',
21             'zoom' => 15,
22             'height' => 500,
23             'width' => 500
24             );
25              
26             my $mm = Net::ModestMaps->new();
27             my $data = $mm->draw(\%args);
28              
29             if (my $err = $data->{'error'}){
30             die "$err->{'message'}";
31             }
32              
33             my $img = $data->{'path'};
34              
35             =head1 DESCRIPTION
36              
37             Simple OOP wrapper for calling the I and I ModestMaps web
38             services.
39              
40             =cut
41              
42 1     1   55979 use URI;
  1         3  
  1         26  
43 1     1   6 use HTTP::Request;
  1         2  
  1         25  
44 1     1   1137 use FileHandle;
  1         13585  
  1         10  
45 1     1   1783 use File::Temp qw(tempfile);
  1         13278  
  1         815  
46              
47             =head1 PACKAGE METHODS
48              
49             =cut
50              
51             =head2 __PACKAGE__->new(%options)
52              
53             Net::ModestMaps subclasses I so all its constructor arguments
54             are valid. No other arguments are required.
55              
56             Returns a I object!
57              
58             =cut
59              
60             sub new {
61 0     0 1   my $pkg = shift;
62              
63 0           my $self = $pkg->SUPER::new(@_);
64              
65 0 0         if (! $self){
66 0           return undef;
67             }
68              
69 0           $self->{'__host'} = 'http://127.0.0.1:9999';
70 0           return bless $self, $pkg;
71             }
72              
73             =head1 OBJECT METHODS
74              
75             =cut
76              
77             =head2 $obj->draw(\%args, $img='')
78              
79             Valid args are any query parameters that you would pass to a ModestMaps web service
80             using the Iquery_form> conventions (multiple parameters with same name passed
81             as an array reference, etc.)
82              
83             I<$img> is the path where the map image returned by the ModestMaps web service should
84             be written to disk. If no argument is passed the map image will be return to a file
85             in your operating system's temporary directory.
86              
87             The method always returns a hash reference, whether or not it succeeded.
88              
89             If a failure condition was encountered the hash will contain a single key
90             labeled "error" which is a pointer to another hash containing (error) "code"
91             and "message" pairs.
92              
93             On success, the hash will contain at least two keys : "path" indicating where the
94             resultant map image was written and "url" indicating the actual URL used to retrieve
95             map image.
96              
97             Additionally, any "X-wscompose-*" headers returned by the ModestMaps server are also
98             stored in the hash.
99              
100             =cut
101              
102             sub draw {
103 0     0 1   my $self = shift;
104 0           my $args = shift;
105 0           my $out = shift;
106              
107 0 0         if (! defined($out)){
108 0           my ($fh, $filename) = tempfile(UNLINK => 0, SUFFIX => ".png");
109 0           $out = $filename;
110             }
111              
112 0           my $host = $self->host();
113              
114 0           my $uri = URI->new('http:');
115 0           $uri->query_form(%$args);
116 0           my $content = $uri->query();
117              
118             # print STDERR $host . "\n";
119             # print STDERR $content . "\n";
120              
121 0           my $req = HTTP::Request->new();
122 0           $req->uri($host);
123 0           $req->method('POST');
124 0           $req->content($content);
125              
126 0           my $res = $self->request($req);
127 0           my $status = $res->code();
128              
129 0 0         if ($status != 200){
130              
131 0           my $h = $res->headers();
132 0           my $code = $h->header('x-errorcode');
133 0           my $msg = $h->header('x-errormessage');
134              
135 0   0       $code ||= $res->code();
136 0   0       $msg ||= $res->message();
137              
138 0           return {'error' => {'code' => $code, 'message' => $msg}};
139             }
140              
141 0           my $fh = FileHandle->new();
142              
143 0 0         if (! $fh->open(">$out")){
144 0           return {'error' => {'code' => 999, 'message' => "can not open '$out' for writing, $!"}};
145             }
146              
147 0           binmode($fh);
148 0           $fh->print($res->content());
149 0           $fh->close();
150              
151 0           my %data = (
152             'url' => join("?", ($host, $content)),
153             'path' => $out,
154             );
155            
156 0           my $headers = $res->headers();
157              
158 0           foreach my $field ($headers->header_field_names()){
159              
160 0 0         if ($field =~/^X-wscompose-(.*)$/i){
161 0           $data{lc($1)} = $headers->header($field);
162             }
163             }
164              
165 0           return \%data;
166             }
167              
168             =head2 $obj->host($url='')
169              
170             Get and set the host where ModestMaps web service requests should be
171             sent.
172              
173             The default values is I
174              
175             =cut
176              
177             sub host {
178 0     0 1   my $self = shift;
179 0           my $host = shift;
180              
181 0 0         if (defined($host)){
182 0           $self->{'__host'} = $host;
183             }
184              
185 0           return $self->{'__host'};
186             }
187              
188             =head2 $obj->ensure_max_header_lines(\@items)
189              
190             By default the I package sets the maximum number of headers that
191             may be returned with a response to 128. If you are plotting lots of "markers"
192             (pinwins, dots, etc.) this number may be too low.
193              
194             This method will check to see how many items you are plotting and update the
195             I config, if necessary.
196            
197             =cut
198              
199             sub ensure_max_header_lines {
200 0     0 1   my $self = shift;
201 0           my $markers = shift;
202              
203 0 0         if (ref($markers) ne "ARRAY"){
204 0           return;
205             }
206              
207 0           my $cnt = scalar(@$markers);
208 0 0         my $max = ($cnt > int(128 * .1)) ? $cnt * 1.2 : $cnt * 1.1;
209              
210 0           return $self->set_max_header_lines(int($max));
211             }
212              
213             sub set_max_header_lines {
214 0     0 0   my $self = shift;
215 0           my $max = shift;
216              
217 0 0         if ($max > 128){
218 0           @LWP::Protocol::http::EXTRA_SOCK_OPTS = ('MaxHeaderLines' => $max);
219             }
220             }
221              
222             =head1 VERSION
223              
224             1.1
225              
226             =head1 DATE
227              
228             $Date: 2008/07/24 06:05:16 $
229              
230             =head1 AUTHOR
231              
232             Aaron Straup Cope Eascope@cpan.orgE
233              
234             =head1 SEE ALSO
235              
236             L
237              
238             L
239              
240             L
241              
242             =head1 BUGS
243              
244             Sure, why not.
245              
246             Please report all bugs via L
247              
248             =head1 LICENSE
249              
250             Copyright (c) 2008 Aaron Straup Cope. All Rights Reserved.
251              
252             This is free software. You may redistribute it and/or
253             modify it under the same terms as Perl itself.
254              
255             =cut
256              
257             return 1;