Flickr-API-1.08/0000755000000000000000000000000012160410304011750 5ustar rootrootFlickr-API-1.08/Changes0000644000000000000000000000166212160410256013256 0ustar rootrootChanges to Flickr::API 0.10, 2008-09-29 * Work correctly with latest XML::Parser::Lite::Tree (now requires 0.06) * Added patch from Flavio Poletti to allow custom api & auth urls 1.01, 2008-09-30 * incorrectly numbered the previous release. gah * updated tests to work when the flickr api isn't hit-able 1.02, 2009-07-31 * license update for fedora 1.03, 2009-08-23 * fix for perl5.6 - when HTTP::Message->decoded_content() comes back empty, use content() instead. 1.04, 2009-08-25 * re-fix for perl5.6 - just require a newer version of HTTP::Message which supports mime-decoding instead. 1.05, 2012-09-12 * Updated Flickr API urls from http://www.flickr.com/services/ to http://api.flickr.com/services/. 1.06, 2013-05-11 * Added `lwpobj` argument, to allow using subclasses of LWP::UserAgent 1.07, 2013-05-23 * Added flag to enable handling of native Unicode strings 1.08, 2013-06-19 * Various cleanup from Gabor Szabo Flickr-API-1.08/META.json0000644000000000000000000000224112160410304013370 0ustar rootroot{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.112621", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Flickr-API", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "runtime" : { "requires" : { "Digest::MD5" : 0, "HTTP::Message" : "1.56", "HTTP::Request" : 0, "HTTP::Response" : 0, "LWP::UserAgent" : 0, "Test::More" : 0, "URI" : "1.18", "XML::Parser::Lite::Tree" : "0.06" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/iamcal/perl-Flickr-API" } }, "version" : "1.08" } Flickr-API-1.08/MANIFEST0000644000000000000000000000043712160410304013105 0ustar rootrootlib/Flickr/API.pm lib/Flickr/API/Request.pm lib/Flickr/API/Response.pm Makefile.PL MANIFEST README t/01-test.t Changes META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Flickr-API-1.08/t/0000755000000000000000000000000012160410303012212 5ustar rootrootFlickr-API-1.08/t/01-test.t0000644000000000000000000000514212160172500013602 0ustar rootrootuse strict; use warnings; use Test::More tests => 20; use Flickr::API; ################################################## # # create an api object # my $api = Flickr::API->new({ 'key' => 'made_up_key', 'secret' => 'my_secret', }); isa_ok $api, 'Flickr::API'; my $rsp = $api->execute_method('fake.method', {}); isa_ok $rsp, 'Flickr::API::Response'; ################################################## # # check we get the 'method not found' error # SKIP: { skip "skipping error code check, since we couldn't reach the API", 1 if $rsp->{_rc} ne '200'; # this error code may change in future! is($rsp->{error_code}, 112, 'checking the error code for "method not found"'); } ################################################## # # check the 'format not found' error is working # $rsp = $api->execute_method('flickr.test.echo', {format => 'fake'}); SKIP: { skip "skipping error code check, since we couldn't reach the API", 1 if $rsp->{_rc} ne '200'; is($rsp->{error_code}, 111, 'checking the error code for "format not found"'); } ################################################## # # check the signing works properly # is($api->sign_args({'foo' => 'bar'}), '466cd24ced0b23df66809a4d2dad75f8', "Signing test 1"); is($api->sign_args({'foo' => undef}), 'f320caea573c1b74897a289f6919628c', "Signing test 2"); $api->{unicode} = 0; is('b8bac3b2a4f919d04821e43adf59288c', $api->sign_args({'foo' => "\xE5\x8C\x95\xE4\xB8\x83"}), "Signing test 3 (unicode=0)"); $api->{unicode} = 1; is('b8bac3b2a4f919d04821e43adf59288c', $api->sign_args({'foo' => "\x{5315}\x{4e03}"}), "Signing test 4 (unicode=1)"); ################################################## # # check the auth url generator is working # my $uri = $api->request_auth_url('r', 'my_frob'); my %expect = parse_query('api_sig=d749e3a7bd27da9c8af62a15f4c7b48f&perms=r&frob=my_frob&api_key=made_up_key'); my %got = parse_query($uri->query); sub parse_query { return split /[&=]/, shift; } foreach my $item (keys %expect) { is($expect{$item}, $got{$item}, "Checking that the $item item in the query matches"); } foreach my $item (keys %got) { is($expect{$item}, $got{$item}, "Checking that the $item item in the query matches in reverse"); } is($uri->path, '/services/auth/', "Checking correct return path"); is($uri->host, 'api.flickr.com', "Checking return domain"); is($uri->scheme, 'http', "Checking return protocol"); ################################################## # # check we can't generate a url without a secret # $api = Flickr::API->new({'key' => 'key'}); $uri = $api->request_auth_url('r', 'frob'); is($uri, undef, "Checking URL generation without a secret"); Flickr-API-1.08/Makefile.PL0000644000000000000000000000110112160172500013716 0ustar rootrootuse ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Flickr::API', 'VERSION_FROM' => 'lib/Flickr/API.pm', 'LICENSE' => 'perl', 'META_MERGE' => { resources => { repository => 'https://github.com/iamcal/perl-Flickr-API', }, }, 'PREREQ_PM' => { 'LWP::UserAgent' => 0, 'HTTP::Request' => 0, 'HTTP::Response' => 0, 'HTTP::Message' => 1.56, # first version of libwww that supports decoded_content() 'URI' => 1.18, 'XML::Parser::Lite::Tree' => 0.06, 'Digest::MD5' => 0, 'Test::More' => 0, }, ); Flickr-API-1.08/lib/0000755000000000000000000000000012160410303012515 5ustar rootrootFlickr-API-1.08/lib/Flickr/0000755000000000000000000000000012160410303013727 5ustar rootrootFlickr-API-1.08/lib/Flickr/API.pm0000644000000000000000000001414612160410175014713 0ustar rootrootpackage Flickr::API; use strict; use warnings; use LWP::UserAgent; use XML::Parser::Lite::Tree; use Flickr::API::Request; use Flickr::API::Response; use Digest::MD5 qw(md5_hex); use Scalar::Util qw(blessed); use Encode qw(encode_utf8); our @ISA = qw(LWP::UserAgent); our $VERSION = '1.08'; sub new { my $class = shift; my $options = shift; my $self; if ($options->{lwpobj}){ my $lwpobj = $options->{lwpobj}; if (defined($lwpobj)){ my $lwpobjtype = Scalar::Util::blessed($lwpobj); if (defined($lwpobjtype)){ $self = $lwpobj; @ISA = ($lwpobjtype); } } } $self = LWP::UserAgent->new unless $self; $self->{api_key} = $options->{key}; $self->{api_secret} = $options->{secret}; $self->{rest_uri} = $options->{rest_uri} || 'http://api.flickr.com/services/rest/'; $self->{auth_uri} = $options->{auth_uri} || 'http://api.flickr.com/services/auth/'; $self->{unicode} = $options->{unicode} || 0; eval { require Compress::Zlib; $self->default_header('Accept-Encoding' => 'gzip'); }; warn "You must pass an API key to the constructor" unless defined $self->{api_key}; bless $self, $class; return $self; } sub sign_args { my $self = shift; my $args = shift; my $sig = $self->{api_secret}; foreach my $key (sort {$a cmp $b} keys %{$args}) { my $value = (defined($args->{$key})) ? $args->{$key} : ""; $sig .= $key . $value; } return md5_hex(encode_utf8($sig)) if $self->{unicode}; return md5_hex($sig); } sub request_auth_url { my $self = shift; my $perms = shift; my $frob = shift; return undef unless defined $self->{api_secret} && length $self->{api_secret}; my %args = ( 'api_key' => $self->{api_key}, 'perms' => $perms ); if ($frob) { $args{frob} = $frob; } my $sig = $self->sign_args(\%args); $args{api_sig} = $sig; my $uri = URI->new($self->{auth_uri}); $uri->query_form(%args); return $uri; } sub execute_method { my ($self, $method, $args) = @_; my $request = Flickr::API::Request->new({ 'method' => $method, 'args' => $args, 'rest_uri' => $self->{rest_uri}, 'unicode' => $self->{unicode}, }); $self->execute_request($request); } sub execute_request { my ($self, $request) = @_; $request->{api_args}->{method} = $request->{api_method}; $request->{api_args}->{api_key} = $self->{api_key}; if (defined($self->{api_secret}) && length($self->{api_secret})){ $request->{api_args}->{api_sig} = $self->sign_args($request->{api_args}); } $request->encode_args(); my $response = $self->request($request); bless $response, 'Flickr::API::Response'; $response->init_flickr(); if ($response->{_rc} != 200){ $response->set_fail(0, "API returned a non-200 status code ($response->{_rc})"); return $response; } my $content = $response->decoded_content(); $content = $response->content() unless defined $content; my $tree = XML::Parser::Lite::Tree::instance()->parse($content); my $rsp_node = $self->_find_tag($tree->{children}); if ($rsp_node->{name} ne 'rsp'){ $response->set_fail(0, "API returned an invalid response"); return $response; } if ($rsp_node->{attributes}->{stat} eq 'fail'){ my $fail_node = $self->_find_tag($rsp_node->{children}); if ($fail_node->{name} eq 'err'){ $response->set_fail($fail_node->{attributes}->{code}, $fail_node->{attributes}->{msg}); }else{ $response->set_fail(0, "Method failed but returned no error code"); } return $response; } if ($rsp_node->{attributes}->{stat} eq 'ok'){ $response->set_ok($rsp_node); return $response; } $response->set_fail(0, "API returned an invalid status code"); return $response; } sub _find_tag { my ($self, $children) = @_; for my $child(@{$children}){ return $child if $child->{type} eq 'element'; } return {}; } 1; __END__ =head1 NAME Flickr::API - Perl interface to the Flickr API =head1 SYNOPSIS use Flickr::API; my $api = Flickr::API->new({ 'key' => 'your_api_key', 'secret' => 'your_app_secret', 'unicode'=> 0, }); my $response = $api->execute_method('flickr.test.echo', { 'foo' => 'bar', 'baz' => 'quux', }); or use Flickr::API; use Flickr::API::Request; my $api = Flickr::API->new({'key' => 'your_api_key'}); my $request = Flickr::API::Request->new({ 'method' => 'flickr.test.echo', 'args' => {}, }); my $response = $api->execute_request($request); =head1 DESCRIPTION A simple interface for using the Flickr API. C is a subclass of L, so all of the various proxy, request limits, caching, etc are available. =head1 METHODS =over =item C 'value', ... })> Returns as new L object. The options are as follows: =over =item C (required) Your API key =item C Your API key's secret =item C & C Override the URIs used for contacting the API. =item C Base the C on this object, instead of creating a new instance of L. This is useful for using the features of e.g. L. =item C This flag controls whether Flicrk::API expects you to pass UTF-8 bytes (unicode=0, the default) or actual unicode strings (unicode=1) in the request. =back =item C Constructs a L object and executes it, returning a L object. =item C Executes a L object, returning a L object. Calls are signed if a secret was specified when creating the L object. =item C Returns a L object representing the URL that an application must redirect a user to for approving an authentication token. For web-based applications I<$frob> is an optional parameter. Returns undef if a secret was not specified when creating the C object. =back =head1 AUTHOR Copyright (C) 2004-2013, Cal Henderson, Ecal@iamcal.comE Auth API patches provided by Aaron Straup Cope Subclassing patch from AHP =head1 SEE ALSO L, L, L, L, L L =cut Flickr-API-1.08/lib/Flickr/API/0000755000000000000000000000000012160410303014340 5ustar rootrootFlickr-API-1.08/lib/Flickr/API/Response.pm0000644000000000000000000000347512160404521016512 0ustar rootrootpackage Flickr::API::Response; use strict; use warnings; use HTTP::Response; our @ISA = qw(HTTP::Response); our $VERSION = '0.02'; sub new { my $class = shift; my $self = HTTP::Response->new; my $options = shift; bless $self, $class; return $self; } sub init_flickr { my ($self, $options) = @_; $self->{tree} = undef; $self->{success} = 0; $self->{error_code} = 0; $self->{error_message} = ''; } sub set_fail { my ($self, $code, $message) = @_; $self->{success} = 0; $self->{error_code} = $code; $self->{error_message} = $message; } sub set_ok { my ($self, $tree) = @_; $self->{success} = 1; $self->{tree} = $tree; } 1; __END__ =head1 NAME Flickr::API::Response - A response from the flickr API. =head1 SYNOPSIS use Flickr::API; use Flickr::API::Response; my $api = Flickr::API->new({'key' => 'your_api_key'}); my $response = $api->execute_method('flickr.test.echo', { 'foo' => 'bar', 'baz' => 'quux', }); print "Success: $response->{success}\n"; =head1 DESCRIPTION This object encapsulates a response from the Flickr API. It's a subclass of L with the following additional keys: { 'success' => 1, 'tree' => XML::Parser::Lite::Tree, 'error_code' => 0, 'error_message' => '', } The C<_request> key contains the request object that this response was generated from. This request will be a L object, which is a subclass of L. The C key contains 1 or 0, indicating whether the request suceeded. If it failed, C and C explain what went wrong. If it suceeded, C contains an L object of the response XML. =head1 AUTHOR Copyright (C) 2004, Cal Henderson, Ecal@iamcal.comE =head1 SEE ALSO L, L =cut Flickr-API-1.08/lib/Flickr/API/Request.pm0000644000000000000000000000347012160404521016337 0ustar rootrootpackage Flickr::API::Request; use strict; use warnings; use HTTP::Request; use URI; use Encode qw(encode_utf8); our @ISA = qw(HTTP::Request); our $VERSION = '0.03'; sub new { my $class = shift; my $options = shift; my $self = HTTP::Request->new; $self->{api_method} = $options->{method}; $self->{api_args} = $options->{args}; $self->{rest_uri} = $options->{rest_uri} || 'http://api.flickr.com/services/rest/'; $self->{unicode} = $options->{unicode} || 0; bless $self, $class; $self->method('POST'); $self->uri($self->{rest_uri}); return $self; } sub encode_args { my ($self) = @_; my $url = URI->new('http:'); if ($self->{unicode}){ for my $k(keys %{$self->{api_args}}){ $self->{api_args}->{$k} = encode_utf8($self->{api_args}->{$k}); } } $url->query_form(%{$self->{api_args}}); my $content = $url->query; $self->header('Content-Type' => 'application/x-www-form-urlencoded'); if (defined($content)) { $self->header('Content-Length' => length($content)); $self->content($content); } } 1; __END__ =head1 NAME Flickr::API::Request - A request to the Flickr API =head1 SYNOPSIS use Flickr::API; use Flickr::API::Request; my $api = Flickr::API->new({'key' => 'your_api_key'}); my $request = Flickr::API::Request->new({ 'method' => $method, 'args' => {}, }); my $response = $api->execute_request($request); =head1 DESCRIPTION This object encapsulates a request to the Flickr API. C is a subclass of L, so you can access any of the request parameters and tweak them yourself. The content, content-type header and content-length header are all built from the 'args' list by the C method. =head1 AUTHOR Copyright (C) 2004, Cal Henderson, Ecal@iamcal.comE =head1 SEE ALSO L. =cut Flickr-API-1.08/META.yml0000644000000000000000000000120512160410304013217 0ustar rootroot--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.112621' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Flickr-API no_index: directory: - t - inc requires: Digest::MD5: 0 HTTP::Message: 1.56 HTTP::Request: 0 HTTP::Response: 0 LWP::UserAgent: 0 Test::More: 0 URI: 1.18 XML::Parser::Lite::Tree: 0.06 resources: repository: https://github.com/iamcal/perl-Flickr-API version: 1.08 Flickr-API-1.08/README0000644000000000000000000000073312143535627012654 0ustar rootrootFlickr::API =========== Simple interface to the Flickr API. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: XML::Parser::Lite::Tree LWP::UserAgent Digest::MD5 HTTP::Request HTTP::Response URI Test::More COPYRIGHT AND LICENCE Copyright (C) 2004-2013 Cal Henderson License: Perl Artistic License 2.0