File Coverage

blib/lib/URI/Amazon/APA.pm
Criterion Covered Total %
statement 50 52 96.1
branch 2 4 50.0
condition 2 5 40.0
subroutine 10 10 100.0
pod 3 3 100.0
total 67 74 90.5


line stmt bran cond sub pod time code
1             package URI::Amazon::APA;
2 2     2   42407 use warnings;
  2         4  
  2         63  
3 2     2   11 use strict;
  2         4  
  2         130  
4             our $VERSION = sprintf "%d.%02d", q$Revision: 0.5 $ =~ /(\d+)/g;
5 2     2   10 use Carp;
  2         19  
  2         156  
6 2     2   3745 use Digest::SHA qw(hmac_sha256_base64);
  2         11729  
  2         200  
7 2     2   3647 use URI::Escape;
  2         3474  
  2         149  
8 2     2   2062 use Encode qw/decode_utf8/;
  2         35512  
  2         199  
9 2     2   20 use base 'URI::http';
  2         5  
  2         1851  
10              
11             sub new{
12 1     1 1 15 my $class = shift;
13 1         9 my $self = URI->new(@_);
14 1 50       373 ref $self eq 'URI::http' or carp "must be http";
15 1         6 bless $self, $class;
16             }
17              
18             sub sign {
19 1     1 1 242 my $self = shift;
20 1         6 my (%arg) = @_;
21 1         6 my %eq = map { split /=/, $_ } split /&/, $self->query();
  7         43  
22 1         6 my %q = map { $_ => decode_utf8( uri_unescape( $eq{$_} ) ) } keys %eq;
  7         212  
23 1 50       41 $q{Keywords} =~ s/\+/ /g if $q{Keywords};
24 1         3 $q{AWSAccessKeyId} = $arg{key};
25 1   33     6 $q{Timestamp} ||= do {
26 0         0 my ( $ss, $mm, $hh, $dd, $mo, $yy ) = gmtime();
27 0         0 join '',
28             sprintf( '%04d-%02d-%02d', $yy + 1900, $mo + 1, $dd ), 'T',
29             sprintf( '%02d:%02d:%02d', $hh, $mm, $ss ), 'Z';
30             };
31 1   50     4 $q{Version} ||= '2010-09-01';
32 7         473 my $sq = join '&',
33 1         9 map { $_ . '=' . uri_escape_utf8( $q{$_}, "^A-Za-z0-9\-_.~" ) }
34             sort keys %q;
35 1         51 my $tosign = join "\n", 'GET', $self->host, $self->path, $sq;
36 1         127 my $signature = hmac_sha256_base64( $tosign, $arg{secret} );
37 1         11 $signature .= '=' while length($signature) % 4; # padding required
38 1         4 $q{Signature} = $signature;
39 1         11 $self->query_form( \%q );
40 1         306 $self;
41             }
42              
43             sub signature {
44 1     1 1 6 my $self = shift;
45 1         3 my (%arg) = @_;
46 1         5 my %eq = map { split /=/, $_ } split /&/, $self->query();
  8         40  
47 1         6 my %q = map { $_ => uri_unescape( $eq{$_} ) } keys %eq;
  8         85  
48 1         21 $q{Signature};
49             }
50              
51             1; # End of URI::Amazon::APA
52              
53             =head1 NAME
54              
55             URI::Amazon::APA - URI to access Amazon Product Advertising API
56              
57             =head1 VERSION
58              
59             $Id: APA.pm,v 0.5 2013/07/16 18:31:07 dankogai Exp $
60              
61             =head1 SYNOPSIS
62              
63             # self-explanatory
64             use strict;
65             use warnings;
66             use URI::Amazon::APA;
67             use LWP::UserAgent;
68             use XML::Simple;
69             use YAML::Syck;
70              
71             use URI::Amazon::APA; # instead of URI
72             my $u = URI::Amazon::APA->new('http://webservices.amazon.com/onca/xml');
73             $u->query_form(
74             Service => 'AWSECommerceService',
75             Operation => 'ItemSearch',
76             Title => shift || 'Perl',
77             SearchIndex => 'Books',
78             );
79             $u->sign(
80             key => $public_key,
81             secret => $private_key,
82             );
83              
84             my $ua = LWP::UserAgent->new;
85             my $r = $ua->get($u);
86             if ( $r->is_success ) {
87             print YAML::Syck::Dump( XMLin( $r->content ) );
88             }
89             else {
90             print $r->status_line, $r->as_string;
91             }
92              
93             =head1 EXPORT
94              
95             None.
96              
97             =head1 METHODS
98              
99             This adds the following methods to L object
100              
101             =head2 sign
102              
103             Sings the URI accordingly to the Amazon Product Advertising API.
104              
105             $u->sign(
106             key => $public_key,
107             secret => $private_key,
108             );
109              
110             =head2 signature
111              
112             Checks the signature within the URI;
113              
114             print "The signature is " : $u->signature;
115              
116             =head1 AUTHOR
117              
118             Dan Kogai, C<< >>
119              
120             =head1 BUGS
121              
122             Please report any bugs or feature requests to C, or through
123             the web interface at L. I will be notified, and then you'll
124             automatically be notified of progress on your bug as I make changes.
125              
126             =head1 SUPPORT
127              
128             You can find documentation for this module with the perldoc command.
129              
130             perldoc URI::Amazon::APA
131              
132              
133             You can also look for information at:
134              
135             =over 4
136              
137             =item * RT: CPAN's request tracker
138              
139             L
140              
141             =item * AnnoCPAN: Annotated CPAN documentation
142              
143             L
144              
145             =item * CPAN Ratings
146              
147             L
148              
149             =item * Search CPAN
150              
151             L
152              
153             =back
154              
155             =head1 ACKNOWLEDGEMENTS
156              
157             L
158              
159             =head1 COPYRIGHT & LICENSE
160              
161             Copyright 2009 Dan Kogai, all rights reserved.
162              
163             This program is free software; you can redistribute it and/or modify it
164             under the same terms as Perl itself.