r10930 - in /branches/upstream/libflickr-api-perl: ./ current/ current/lib/ current/lib/Flickr/ current/lib/Flickr/API/
ghostbar-guest at users.alioth.debian.org
ghostbar-guest at users.alioth.debian.org
Thu Dec 6 19:56:17 UTC 2007
Author: ghostbar-guest
Date: Thu Dec 6 19:56:17 2007
New Revision: 10930
URL: http://svn.debian.org/wsvn/?sc=1&rev=10930
Log:
[svn-inject] Installing original source of libflickr-api-perl
Added:
branches/upstream/libflickr-api-perl/
branches/upstream/libflickr-api-perl/current/
branches/upstream/libflickr-api-perl/current/MANIFEST
branches/upstream/libflickr-api-perl/current/META.yml
branches/upstream/libflickr-api-perl/current/Makefile.PL
branches/upstream/libflickr-api-perl/current/README
branches/upstream/libflickr-api-perl/current/lib/
branches/upstream/libflickr-api-perl/current/lib/Flickr/
branches/upstream/libflickr-api-perl/current/lib/Flickr/API/
branches/upstream/libflickr-api-perl/current/lib/Flickr/API.pm
branches/upstream/libflickr-api-perl/current/lib/Flickr/API/Request.pm
branches/upstream/libflickr-api-perl/current/lib/Flickr/API/Response.pm
branches/upstream/libflickr-api-perl/current/test.pl
Added: branches/upstream/libflickr-api-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libflickr-api-perl/current/MANIFEST?rev=10930&op=file
==============================================================================
--- branches/upstream/libflickr-api-perl/current/MANIFEST (added)
+++ branches/upstream/libflickr-api-perl/current/MANIFEST Thu Dec 6 19:56:17 2007
@@ -1,0 +1,8 @@
+lib/Flickr/API.pm
+lib/Flickr/API/Request.pm
+lib/Flickr/API/Response.pm
+Makefile.PL
+MANIFEST
+README
+test.pl
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libflickr-api-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libflickr-api-perl/current/META.yml?rev=10930&op=file
==============================================================================
--- branches/upstream/libflickr-api-perl/current/META.yml (added)
+++ branches/upstream/libflickr-api-perl/current/META.yml Thu Dec 6 19:56:17 2007
@@ -1,0 +1,17 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Flickr-API
+version: 0.08
+version_from: lib/Flickr/API.pm
+installdirs: site
+requires:
+ Digest::MD5: 0
+ HTTP::Request: 0
+ HTTP::Response: 0
+ LWP::UserAgent: 0
+ Test::More: 0
+ URI: 1.18
+ XML::Parser::Lite::Tree: 0.03
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: branches/upstream/libflickr-api-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libflickr-api-perl/current/Makefile.PL?rev=10930&op=file
==============================================================================
--- branches/upstream/libflickr-api-perl/current/Makefile.PL (added)
+++ branches/upstream/libflickr-api-perl/current/Makefile.PL Thu Dec 6 19:56:17 2007
@@ -1,0 +1,15 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Flickr::API',
+ 'VERSION_FROM' => 'lib/Flickr/API.pm',
+ 'PREREQ_PM' => {
+ 'LWP::UserAgent' => 0,
+ 'HTTP::Request' => 0,
+ 'HTTP::Response' => 0,
+ 'URI' => 1.18,
+ 'XML::Parser::Lite::Tree' => 0.03,
+ 'Digest::MD5' => 0,
+ 'Test::More' => 0,
+ },
+);
Added: branches/upstream/libflickr-api-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libflickr-api-perl/current/README?rev=10930&op=file
==============================================================================
--- branches/upstream/libflickr-api-perl/current/README (added)
+++ branches/upstream/libflickr-api-perl/current/README Thu Dec 6 19:56:17 2007
@@ -1,0 +1,34 @@
+Flickr::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-2006 Cal Henderson <cal at iamcal.com>
+License: Perl Artistic License
+
Added: branches/upstream/libflickr-api-perl/current/lib/Flickr/API.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libflickr-api-perl/current/lib/Flickr/API.pm?rev=10930&op=file
==============================================================================
--- branches/upstream/libflickr-api-perl/current/lib/Flickr/API.pm (added)
+++ branches/upstream/libflickr-api-perl/current/lib/Flickr/API.pm Thu Dec 6 19:56:17 2007
@@ -1,0 +1,217 @@
+package 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);
+
+our @ISA = qw(LWP::UserAgent);
+
+our $VERSION = '0.08';
+
+sub new {
+ my $class = shift;
+ my $options = shift;
+ my $self = new LWP::UserAgent;
+ $self->{api_key} = $options->{key};
+ $self->{api_secret} = $options->{secret};
+
+ 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($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('http://flickr.com/services/auth');
+ $uri->query_form(%args);
+
+ return $uri;
+}
+
+sub execute_method {
+ my ($self, $method, $args) = @_;
+
+ my $request = new Flickr::API::Request({'method' => $method, 'args' => $args});
+
+ $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 $tree = XML::Parser::Lite::Tree::instance()->parse($response->{_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 'tag';
+ }
+ return {};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Flickr::API - Perl interface to the Flickr API
+
+=head1 SYNOPSIS
+
+ use Flickr::API;
+
+ my $api = new Flickr::API({'key' => 'your_api_key',
+ 'secret' => 'your_app_secret'});
+
+ my $response = $api->execute_method('flickr.test.echo', {
+ 'foo' => 'bar',
+ 'baz' => 'quux',
+ });
+
+or
+
+ use Flickr::API;
+ use Flickr::API::Request;
+
+ my $api = new Flickr::API({'key' => 'your_api_key'});
+
+ my $request = new Flickr::API::Request({
+ 'method' => 'flickr.test.echo',
+ 'args' => {},
+ });
+
+ my $response = $api->execute_request($request);
+
+
+=head1 DESCRIPTION
+
+A simple interface for using the Flickr API.
+
+C<Flickr::API> is a subclass of L<LWP::UserAgent>, so all of the various
+proxy, request limits, caching, etc are available.
+
+=head2 METHODS
+
+=over 4
+
+=item C<execute_method($method, $args)>
+
+Constructs a C<Flickr::API::Request> object and executes it, returning a C<Flickr::API::Response> object.
+
+=item C<execute_request($request)>
+
+Executes a C<Flickr::API::Request> object, returning a C<Flickr::API::Response> object. Calls are signed
+if a secret was specified when creating the C<Flickr::API> object.
+
+=item C<request_auth_url($perms,$frob)>
+
+Returns a C<URI> 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<Flickr::API> object.
+
+
+=back
+
+
+=head1 AUTHOR
+
+Copyright (C) 2004-2005, Cal Henderson, E<lt>cal at iamcal.comE<gt>
+
+Auth API patches provided by Aaron Straup Cope
+
+
+=head1 SEE ALSO
+
+L<Flickr::API::Request>,
+L<Flickr::API::Response>,
+L<XML::Parser::Lite>,
+L<http://www.flickr.com/>,
+L<http://www.flickr.com/services/api/>
+
+=cut
Added: branches/upstream/libflickr-api-perl/current/lib/Flickr/API/Request.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libflickr-api-perl/current/lib/Flickr/API/Request.pm?rev=10930&op=file
==============================================================================
--- branches/upstream/libflickr-api-perl/current/lib/Flickr/API/Request.pm (added)
+++ branches/upstream/libflickr-api-perl/current/lib/Flickr/API/Request.pm Thu Dec 6 19:56:17 2007
@@ -1,0 +1,81 @@
+package Flickr::API::Request;
+
+use strict;
+use warnings;
+use HTTP::Request;
+use URI;
+
+our @ISA = qw(HTTP::Request);
+our $VERSION = '0.02';
+
+sub new {
+ my $class = shift;
+ my $self = new HTTP::Request;
+ my $options = shift;
+ $self->{api_method} = $options->{method};
+ $self->{api_args} = $options->{args};
+ bless $self, $class;
+
+ $self->method('POST');
+ $self->uri('http://www.flickr.com/services/rest/');
+
+ return $self;
+}
+
+sub encode_args {
+ my ($self) = @_;
+
+ my $url = URI->new('http:');
+ $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 = new Flickr::API({'key' => 'your_api_key'});
+
+ my $request = new Flickr::API::Request({
+ 'method' => $method,
+ 'args' => {},
+ });
+
+ my $response = $api->execute_request($request);
+
+
+=head1 DESCRIPTION
+
+This object encapsulates a request to the Flickr API.
+
+C<Flickr::API::Request> is a subclass of C<HTTP::Request>, 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<Flickr::API::execute_request()> method.
+
+
+=head1 AUTHOR
+
+Copyright (C) 2004, Cal Henderson, E<lt>cal at iamcal.comE<gt>
+
+
+=head1 SEE ALSO
+
+L<Flickr::API>.
+
+=cut
Added: branches/upstream/libflickr-api-perl/current/lib/Flickr/API/Response.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libflickr-api-perl/current/lib/Flickr/API/Response.pm?rev=10930&op=file
==============================================================================
--- branches/upstream/libflickr-api-perl/current/lib/Flickr/API/Response.pm (added)
+++ branches/upstream/libflickr-api-perl/current/lib/Flickr/API/Response.pm Thu Dec 6 19:56:17 2007
@@ -1,0 +1,96 @@
+package 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 = new HTTP::Response;
+ 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 = new Flickr::API({'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 C<HTTP::Response> 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 C<Flickr::API::Request>
+object, which is a subclass of C<HTTP:Request>.
+
+The C<sucess> key contains 1 or 0, indicating
+whether the request suceeded. If it failed, C<error_code> and
+C<error_message> explain what went wrong. If it suceeded, C<tree>
+contains an C<XML::Parser::Lite::Tree> object of the response XML.
+
+
+=head1 AUTHOR
+
+Copyright (C) 2004, Cal Henderson, E<lt>cal at iamcal.comE<gt>
+
+
+=head1 SEE ALSO
+
+L<Flickr::API>,
+L<XML::Parser::Lite>
+
+=cut
+
Added: branches/upstream/libflickr-api-perl/current/test.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libflickr-api-perl/current/test.pl?rev=10930&op=file
==============================================================================
--- branches/upstream/libflickr-api-perl/current/test.pl (added)
+++ branches/upstream/libflickr-api-perl/current/test.pl Thu Dec 6 19:56:17 2007
@@ -1,0 +1,87 @@
+use Test::More;
+BEGIN { plan tests => 17 };
+
+BEGIN { use_ok( 'Flickr::API' ); }
+
+
+##################################################
+#
+# create an api object
+#
+
+my $api = new Flickr::API({
+ 'key' => 'made_up_key',
+ 'secret' => 'my_secret',
+ });
+my $rsp = $api->execute_method('fake.method', {});
+
+
+##################################################
+#
+# check we get the 'method not found' error
+#
+
+# this error code will change in future!
+is($rsp->{error_code}, 112, 'checking the error code for "method not found"');
+
+#print "code was $rsp->{error_code}, msg was $rsp->{error_message}\n";
+
+
+##################################################
+#
+# check the 'format not found' error is working
+#
+
+$rsp = $api->execute_method('flickr.test.echo', {format => 'fake'});
+is($rsp->{error_code}, 111, 'checking the error code for "format not found"');
+
+
+##################################################
+#
+# check the signing works properly
+#
+
+ok('466cd24ced0b23df66809a4d2dad75f8' eq $api->sign_args({'foo' => 'bar'}), "Signing test 1");
+ok('f320caea573c1b74897a289f6919628c' eq $api->sign_args({'foo' => undef}), "Signing test 2");
+
+
+##################################################
+#
+# 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 {
+ my %hash;
+ foreach my $pair (split(/\&/, shift)) {
+ my ($name, $value) = split(/\=/, $pair);
+ $hash{$name} = $value;
+ }
+ return(%hash);
+}
+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");
+}
+
+ok($uri->path eq '/services/auth', "Checking correct return path");
+ok($uri->host eq 'flickr.com', "Checking return domain");
+ok($uri->scheme eq 'http', "Checking return protocol");
+
+
+##################################################
+#
+# check we can't generate a url without a secret
+#
+
+$api = new Flickr::API({'key' => 'key'});
+$uri = $api->request_auth_url('r', 'frob');
+
+ok(!defined $uri, "Checking URL generation without a secret");
+
More information about the Pkg-perl-cvs-commits
mailing list