File Coverage

blib/lib/URL/Signature/Google/Maps/API.pm
Criterion Covered Total %
statement 55 93 59.1
branch 15 44 34.0
condition n/a
subroutine 13 18 72.2
pod 8 8 100.0
total 91 163 55.8


line stmt bran cond sub pod time code
1             package URL::Signature::Google::Maps::API;
2 2     2   44068 use strict;
  2         4  
  2         74  
3 2     2   10 use warnings;
  2         3  
  2         63  
4 2     2   9 use base qw{Package::New};
  2         9  
  2         1589  
5 2     2   2026 use Path::Class qw{file dir};
  2         98635  
  2         149  
6 2     2   2243 use Config::IniFiles qw{};
  2         31542  
  2         47  
7 2     2   1631 use MIME::Base64 qw{};
  2         1470  
  2         40  
8 2     2   1322 use Digest::HMAC_SHA1 qw{};
  2         69190  
  2         1660  
9              
10             our $VERSION='0.01';
11              
12             =head1 NAME
13              
14             URL::Signature::Google::Maps::API - Sign URLs for use with Google Maps API Enterprise Business Accounts
15              
16             =head1 SYNOPSIS
17              
18             use URL::Signature::Google::Maps::API;
19             my $signer = URL::Signature::Google::Maps::API->new();
20             my $server = "http://maps.googleapis.com";
21             my $path_query = "/maps/api/staticmap?size=600x300&markers=Clifton,VA&sensor=false";
22             my $url = $signer->url($server => $path_query);
23              
24             =head1 DESCRIPTION
25              
26             Generates a signed URL for use in the Google Maps API. The Google Enterprise keys can be stored in an INI file (i.e. /etc/google.conf) or passed on assignment..
27              
28             =head1 CONSTRUCTOR
29              
30             =head2 new
31              
32             Use client and key from INI file /etc/google.conf
33              
34             my $signer=URL::Signature::Google::Maps::API->new(channel => "myapp");
35              
36             Use client and key from construction
37              
38             my $signer=URL::Signature::Google::Maps::API->new(
39             client => "abc-xyzpdq",
40             key => "xUUUUUUUUUUUU-UUUUUUUUUUUUU=",
41             channel => "myapp",
42             );
43              
44             Don't use client or signature just pass through URLs
45              
46             my $signer=URL::Signature::Google::Maps::API->new(client=>"");
47              
48             =head1 USAGE
49              
50             =head2 url
51              
52             Returns a signed URL given a two part URL of server and path_query.
53              
54             my $url=$signer->url($server => $path_query);
55              
56             Example
57              
58             my $url=$signer->url("http://maps.googleapis.com" => "/maps/api/staticmap?size=600x300&markers=Clifton,VA&sensor=false");
59              
60             This method adds client and channel parameters (if configured) so they should not be added to the passed in path query.
61              
62             =cut
63              
64             sub url {
65 3     3 1 1233 my $self = shift;
66 3         5 my $server = shift;
67 3         4 my $path_query = shift;
68 3 50       9 if ($self->client) {
69 0 0       0 $path_query.=sprintf("&channel=%s", $self->channel) if $self->channel;
70 0         0 $path_query.=sprintf("&client=%s", $self->client);
71             }
72 3         7 my $url=$server . $path_query;
73 3 50       5 $url.=sprintf("&signature=%s", $self->signature($path_query)) if $self->client;
74             #warn("URL: $url\n");
75 3         14 return $url;
76             }
77              
78             =head2 signature
79              
80             Returns the signature value if you want to use the mathematics without the url method.
81              
82             my $path_query = "/path/script" . "?" . $query;
83             my $url=$protocol_$server . $path_query . "&signature=" . $signer->signature($path_query);
84              
85             =cut
86              
87             sub signature {
88 0     0 1 0 my $self = shift;
89 0         0 my $path_query = shift;
90 0         0 my $signature = $self->_Digest->reset->add($path_query)->b64digest;
91 0         0 $signature =~ tr/\+/\-/;
92 0         0 $signature =~ tr/\//\_/;
93 0         0 return $signature;
94             }
95              
96             =head1 Google Enterprise Credentials
97              
98             You may store the credentials in an INI formatted file or you may specify the credentials on construction or after construction.
99              
100             Configuration file format
101              
102             [GoogleAPI]
103             client=abc-xyzpdq
104             key=xUUUUUUUUUUUU-UUUUUUUUUUUUU=
105              
106             =head2 client
107              
108             Sets and returns the Google Enterprise Client
109              
110             Default: Value from INI file
111              
112             $signer->client("abc-xyzpdq");
113              
114             =cut
115              
116             sub client {
117 6     6 1 6 my $self=shift;
118 6 50       13 $self->{"client"}=shift if @_;
119 6 100       17 $self->_setCredentials unless defined $self->{"client"};
120 6         18 return $self->{"client"};
121             }
122              
123             =head2 key
124              
125             Sets and returns the Google Enterprise Key
126              
127             Default: Value from INI file
128              
129             $signer->key("xUUUUUUUUUUUU-UUUUUUUUUUUUU=");
130              
131             =cut
132              
133             sub key {
134 0     0 1 0 my $self=shift;
135 0 0       0 $self->{"key"}=shift if @_;
136 0 0       0 $self->_setCredentials unless defined $self->{"key"};
137 0         0 return $self->{"key"};
138             }
139              
140             sub _setCredentials {
141 2     2   2 my $self=shift;
142 2 50       6 if (-r $self->config_filename) {
143 0         0 $self->{"key"} = $self->_ConfigIniFiles->val("GoogleAPI", "key" , "");
144 0         0 $self->{"client"} = $self->_ConfigIniFiles->val("GoogleAPI", "client", "");
145             } else {
146 2         30 $self->{"key"} = "";
147 2         4 $self->{"client"} = "";
148             }
149 2         3 return $self;
150             }
151              
152             =head2 channel
153              
154             Sets and returns the Google Enterprise channel for determining application in Google Enterprise Support Portal (L).
155              
156             Default: ""
157              
158             Note: This is a per application setting not a per user setting.
159              
160             =cut
161              
162             sub channel {
163 0     0 1 0 my $self=shift;
164 0 0       0 $self->{"channel"}=shift if @_;
165 0 0       0 $self->{"channel"}="" unless defined $self->{"channel"};
166 0         0 return $self->{"channel"};
167             }
168              
169             =head2 config_filename
170              
171             Sets and returns the filename of the configuration file.
172              
173             Default: /etc/google.conf
174              
175             =cut
176              
177             sub config_filename {
178 2     2 1 3 my $self=shift;
179 2 50       5 $self->{"config_filename"}=shift if @_;
180 2 100       5 unless (defined $self->{"config_filename"}) {
181 1         2 my $filename;
182 1         4 foreach my $path ($self->config_paths) {
183 1         3 $filename=file($path, $self->config_basename);
184 1 50       257 last if -r $filename;
185             }
186 1         60 $self->{"config_filename"}=$filename;
187             }
188 2         15 return $self->{"config_filename"};
189             }
190              
191             =head2 config_paths
192              
193             Sets and returns a list of L objects to check for a readable basename.
194              
195             Precedence: sysconfdir (i.e. /etc), Perl script directory, then current directory (i.e. ".")
196              
197             Default: [/etc, $0->dir, .]
198              
199             =cut
200              
201             sub config_paths {
202 1     1 1 3 my $self=shift;
203 1 50       3 $self->{"config_paths"}=shift if @_;
204 1 50       4 unless (ref($self->{"config_paths"}) eq "ARRAY") {
205 0         0 my @paths=(file($0)->dir, dir(".")); #current directory is default
206 0 0       0 if ($^O ne "MSWin32") {
207 0         0 eval("use Sys::Path");
208 0 0       0 if ($@) {
209 0         0 unshift @paths, dir("/etc");
210             } else {
211 0         0 unshift @paths, dir(Sys::Path->sysconfdir);
212             }
213             }
214 0         0 $self->{"config_paths"}=\@paths;
215             }
216 1 50       3 return wantarray ? @{$self->{"config_paths"}} : $self->{"config_paths"};
  1         3  
217             }
218              
219             =head2 config_basename
220              
221             Sets and returns the basename for the Google configuration file.
222              
223             Default: google.conf
224              
225             =cut
226              
227             sub config_basename {
228 1     1 1 2 my $self=shift;
229 1 50       4 $self->{"config_basename"}=shift if @_;
230 1 50       4 $self->{"config_basename"}="google.conf" unless defined $self->{"config_basename"};
231 1         5 return $self->{"config_basename"};
232             }
233              
234             #head1 Object Accessors
235             #
236             #head2 _ConfigIniFiles
237             #
238             #Returns the cached L object
239             #
240             #=cut
241              
242             sub _ConfigIniFiles {
243 0     0     my $self=shift;
244 0 0         unless (defined $self->{'_ConfigIniFiles'}) {
245 0           my $filename=$self->config_filename; #support for objects that can stringify paths.
246 0           $self->{'_ConfigIniFiles'}=Config::IniFiles->new(-file=>"$filename");
247             }
248 0           return $self->{'_ConfigIniFiles'};
249             }
250              
251             #head2 _Digest
252             #
253             #Returns a cached L object initialized with the enterprise key.
254             #
255             #Note: Must be reset before re-use.
256             #
257             # my $digest=$signer->Digest->reset;
258             #
259             #cut
260              
261             sub _Digest {
262 0     0     my $self=shift;
263 0 0         unless (defined $self->{"_Digest"}) {
264 0           my $base64=$self->key;
265             #$content =~ tr{-_}{+/}; #tweak from Geo::Coder::Google::V3
266 0           $base64 =~ tr/-/\+/;
267 0           $base64 =~ tr/_/\//;
268 0           my $binary=MIME::Base64::decode_base64($base64);
269 0           $self->{"_Digest"}=Digest::HMAC_SHA1->new($binary);
270             }
271 0           return $self->{"_Digest"};
272             }
273              
274             =head1 BUGS
275              
276             Please log on RT and send an email to the author.
277              
278             =head1 SUPPORT
279              
280             DavisNetworks.com supports all Perl applications including this package.
281              
282             =head1 AUTHOR
283              
284             Michael R. Davis
285             CPAN ID: MRDVT
286             Satellite Tracking of People, LLC
287             mdavis@stopllc.com
288             http://www.stopllc.com/
289              
290             =head1 COPYRIGHT
291              
292             This program is free software licensed under the...
293              
294             The General Public License (GPL)
295             Version 2, June 1991
296              
297             The full text of the license can be found in the LICENSE file included with this module.
298              
299             =head1 SEE ALSO
300              
301             L, L, L
302              
303             =cut
304              
305             1;