Net::Flickr::API - base API class for Net::Flickr::* libraries

Net-Flickr-API documentation Contained in the Net-Flickr-API distribution.

Index

Code Index:

NAME

Top

Net::Flickr::API - base API class for Net::Flickr::* libraries

SYNOPSIS

Top

 package Net::Flickr::RDF;
 use base qw (Net::Flickr::API);

DESCRIPTION

Top

Base API class for Net::Flickr::* libraries

Net::Flickr::API is a wrapper for Flickr::API that provides support for throttling API calls (per second), retries if the API is disabled and marshalling of API responses into XML::LibXML or XML::XPath objects.

OPTIONS

Top

Options are passed to Net::Flickr::Backup using a Config::Simple object or a valid Config::Simple config file. Options are grouped by "block".

flick

* api_key

String. required

A valid Flickr API key.

* api_secret

String. required

A valid Flickr Auth API secret key.

* auth_token

String. required

A valid Flickr Auth API token.

* api_handler

String. required

The api_handler defines which XML/XPath handler to use to process API responses.

* LibXML

Use XML::LibXML.

* XPath

Use XML::XPath.

reporting

* enabled

Boolean.

Default is false.

* handler

String.

The default handler is Screen, as in Log::Dispatch::Screen

* handler_args

For example, the following :

 reporting_handler_args=name:foobar;min_level=info

Would be converted as :

 (name      => "foobar",
  min_level => "info");

The default name argument is "__report". The default min_level argument is "info".

PACKAGE METHODS

Top

__PACKAGE__->new($cfg)

Where $cfg is either a valid Config::Simple object or the path to a file that can be parsed by Config::Simple.

Returns a Net::Flickr::API object.

OBJECT METHODS

Top

$obj->api_call(\%args)

Valid args are :

* method

A string containing the name of the Flickr API method you are calling.

* args

A hash ref containing the key value pairs you are passing to method

If the method encounters any errors calling the API, receives an API error or can not parse the response it will log an error event, via the log method, and return undef.

Otherwise it will return a XML::LibXML::Document object (if XML::LibXML is installed) or a XML::XPath object.

$obj->get_auth()

Return an XML node element containing the Flickr auth token information for the current object.

Returns undef if no token information is present.

$obj->get_auth_nsid()

Return the Flickr NSID of the user associated with the Flickr auth token information for the current object.

Returns undef if no token information is present.

$obj->upload(\%args)

This is a helper method that simply wraps calls to the Flickr::Upload upload method. All the arguments are the same. For complete documentation please consult:

http://search.cpan.org/dist/Flickr-Upload/Upload.pm#upload

(Note: There's no need to pass an auth_token argument as the wrapper will take care of for you.)

Returns a photo ID (or a ticket ID if the call is asynchronous) on success or false if there was a problem.

$obj->log()

Returns a Log::Dispatch object.

VERSION

Top

1.7

DATE

Top

$Date: 2009/08/02 17:16:12 $

AUTHOR

Top

Aaron Straup Cope <ascope@cpan.org>

SEE ALSO

Top

Config::Simple

Flickr::API

XML::XPath

XML::LibXML

BUGS

Top

Please report all bugs via http://rt.cpan.org/

LICENSE

Top

Copyright (c) 2005-2008 Aaron Straup Cope. All Rights Reserved.

This is free software. You may redistribute it and/or modify it under the same terms as Perl itself.

Net-Flickr-API documentation Contained in the Net-Flickr-API distribution. 
use strict;

# $Id: API.pm,v 1.35 2009/08/02 17:16:12 asc Exp $
# -*-perl-*-

package Net::Flickr::API;

$Net::Flickr::API::VERSION = '1.7';


use Config::Simple;

use Flickr::API;
use Flickr::Upload;

use Readonly;
use Data::Dumper;

use Log::Dispatch;
use Log::Dispatch::Screen;

Readonly::Scalar my $PAUSE_SECONDS_OK          => 2;
Readonly::Scalar my $PAUSE_SECONDS_UNAVAILABLE => 4;
Readonly::Scalar my $PAUSE_MAXTRIES            => 10;
Readonly::Scalar my $PAUSE_ONSTATUS            => 503;

Readonly::Scalar my $RETRY_MAXTRIES            => 10;


sub new {
        my $pkg = shift;
        my $cfg = shift;
    
        my $self = {'__wait'    => time() + $PAUSE_SECONDS_OK,
                    '__paused'  => 0,
                    '__retries' => 0,};
        
        bless $self,$pkg;
        
        if (! $self->init($cfg)) {
                undef $self;
        }
        
        return $self;
}

sub init {
        my $self = shift;
        my $cfg  = shift;
        
        $self->{cfg} = (UNIVERSAL::isa($cfg, "Config::Simple")) ? $cfg : Config::Simple->new($cfg);
        
        if ($self->{cfg}->param("flickr.api_handler") !~ /^(?:XPath|LibXML)$/) {
                warn "Invalid API handler";
                return 0;
        }
        
        #
        
        my $log_fmt = sub {
                my %args = @_;
                
                my $msg = $args{'message'};
                chomp $msg;
                
                if ($args{'level'} eq "error") {
                        
                        my ($ln, $sub) = (caller(4))[2,3];
                        $sub =~ s/.*:://;
                        
                        return sprintf("[%s][%s, ln%d] %s\n",
                                       $args{'level'}, $sub, $ln, $msg);
                }
                
                return sprintf("[%s] %s\n", $args{'level'}, $msg);
        };
        
        my $logger = Log::Dispatch->new(callbacks=>$log_fmt);
        my $error  = Log::Dispatch::Screen->new(name      => '__error',
                                                min_level => 'error',
                                                stderr    => 1);
        
        $logger->add($error);

        #
        # Custom report logging
        #

        if ($self->{cfg}->param("reporting.enable")) {

                my $report_handler = $self->{cfg}->param("reporting.handler") || "Screen";
                $report_handler    =~ s/:://g;

                my $report_pkg = "Log::Dispatch::$report_handler";
                eval "require $report_pkg";

                if ($@) {
                        warn "Failed to load $report_pkg, $@";
                        return 0;
                }

                my %report_args = ();

                if (my $args = $self->{cfg}->param("reporting.handler_args")) {

                        foreach my $part (split(",", $args)) {
                                my ($key, $value) = split(":", $part);
                                $report_args{$key} = $value;
                        }
                }

                $report_args{'name'}      ||= "__report";
                $report_args{'min_level'} ||= "info";

                my $reporter = $report_pkg->new(%report_args);

                if (! $reporter) {
                        warn "Failed to instantiate $report_pkg, $!";
                        return 0;
                }

                $logger->add($reporter);
        }

        $self->{'__logger'} = $logger;

        #
        
        $self->{api} = Flickr::API->new({key     => $self->{cfg}->param("flickr.api_key"),
                                         secret  => $self->{cfg}->param("flickr.api_secret"),
                                         handler => $self->{cfg}->param("flickr.api_handler")});
        
        my $pkg     = ref($self);
        my $version = undef;
        
        do {
                my $ref = join("::", $pkg, "VERSION");
                
                no strict "refs";
                $version = ${$ref};
        };
        
        my $agent_string = sprintf("%s/%s", $pkg, $version);
        
        $self->{api}->agent($agent_string);
        return 1;
}


sub api_call {
        my $self = shift;
        my $args = shift;
        
        #
        
        # check to see if we need to take
        # breather (are we pounding or are
        # we not?)

        while (time < $self->{'__wait'}) {

                my $debug_msg = sprintf("trying not to beat up the Flickr servers, pause for %.2f seconds\n",
                                        $PAUSE_SECONDS_OK);

                $self->log()->debug($debug_msg);
                sleep($PAUSE_SECONDS_OK);
        }
        
        # send request
  
        if (exists($args->{'args'}->{'api_sig'})) {
                delete $args->{'args'}->{'api_sig'};
        }

        $args->{'args'}->{'auth_token'} = $self->{cfg}->param("flickr.auth_token");

        #

        my $req = Flickr::API::Request->new($args);
        my $res = undef;

        $self->log()->debug("calling $args->{method} : " . Dumper($args->{args}));
        
        eval {
                $res = $self->{'api'}->execute_request($req);
        };

        if ($@) {
                $self->log()->error("Fatal error calling the Flickr API, $@");

                $self->{'__wait'}   = time + $PAUSE_SECONDS_OK;
                $self->{'__paused'} = 0;
                return undef;
        }

        #
        # check for 503 status
        #

        if ($res->code() eq $PAUSE_ONSTATUS) {
                $res = $self->retry_api_call($args, $res);
        }
        
        $self->{'__wait'}   = time + $PAUSE_SECONDS_OK;
        $self->{'__paused'} = 0;

        return $self->parse_api_call($args, $res);
}


sub get_auth {
        my $self = shift;
        
        if (! $self->{'__auth'}) {
                my $auth = $self->api_call({"method" => "flickr.auth.checkToken"});
                
                if (! $auth) {
                        return undef;
                }
                
                my $nsid = $auth->find("/rsp/auth/user/\@nsid")->string_value();
                
                if (! $nsid) {
                        $self->log()->error("unabled to determine ID for token");
                        return undef;
                }
                
                $self->{'__auth'} = $auth;
        }
        
        return $self->{'__auth'};
}


sub get_auth_nsid {
        my $self = shift;

        if (my $auth = $self->get_auth()){
                return $auth->find("/rsp/auth/user/\@nsid")->string_value();
        }

        return undef;
}

sub parse_api_call {
        my $self = shift;
        my $args = shift;
        my $res  = shift;

        $self->log()->debug($res->decoded_content());

        my $xml = $self->_parse_results_xml($res);

        if (! $xml) {
                $self->log()->error("failed to parse API response, calling $args->{method}");
                $self->log()->error($res->decoded_content());
                return undef;
        }

        my $stat = $xml->find("/rsp/\@stat")->string_value();

        if ($stat eq "fail") {
                my $code = $xml->findvalue("/rsp/err/\@code");
                my $msg  = $xml->findvalue("/rsp/err/\@msg");

                $self->log()->error(sprintf("[%s] %s (calling $args->{method})\n",
                                            $code,
                                            $msg));

                if ($code==0) {
                        $self->log()->info(sprintf("api disabled attempting %s/%s tries to see if it's come back up", $self->{'__retries'}, $RETRY_MAXTRIES));
                        return $self->api_disabled($args, $res);                
                }
        }

        $self->{'__retries'} = 0;

        return ($@) ? undef : $xml;
}

sub _parse_results_xml {
        my $self = shift;
        my $res  = shift;

        my $xml = undef;

        #
        # Please for Cal to someday accept the patch to add
        # response handlers to Flickr::API...
        #

        if ($self->{cfg}->param("flickr.api_handler") eq "XPath") {
                eval "require XML::XPath";

                if (! $@) {
                        eval {
                                $xml = XML::XPath->new(xml=>$res->decoded_content());
                        };
                }
        }
        
        else {
                eval "require XML::LibXML";

                if (! $@) {
                        eval {
                                my $parser = XML::LibXML->new();
                                $xml = $parser->parse_string($res->decoded_content());
                        };
                }
        }
        
        #

        if (! $xml) {
                $self->log()->error("XML parse error : $@");
                return undef;
        }
        
        #

        return $xml;
}

sub api_disabled {
        my $self = shift;
        my $args = shift;
        my $res  = shift;

        $self->{'__retries'} ++;

        if ($self->{'__retries'} > $RETRY_MAXTRIES) {
                $self->log()->critical(sprintf("API still down after %s tries - exiting", $RETRY_MAXTRIES));
                exit;
        }

        $res = $self->retry_api_call($args, $res);

        if (! $res) {
                $self->log()->critical("Returned false during 'api disabled' retry. That can only be bad - exiting");
                exit;
        }

        return $res;
}

sub retry_api_call {
        my $self = shift;
        my $args = shift;
        my $res  = shift;

        # you are in a dark and twisty corridor
        # where all the errors look the same - 
        # just give up if we hit this ceiling
        
        $self->{'__paused'} ++;
        
        if ($self->{'__paused'} > $PAUSE_MAXTRIES) {
                
                my $errmsg = sprintf("service returned '%d' status %d times; exiting",
                                     $PAUSE_ONSTATUS, $PAUSE_MAXTRIES);
                
                $self->log()->error($errmsg);
                return undef;
        }
        
        my $retry_after = $res->header("Retry-After");
        my $debug_msg   = undef;
        
        if ($retry_after ) {
                $debug_msg = sprintf("service unavailable, requested to retry in %d seconds",
                                     $retry_after);
        } 
        
        else {
                $retry_after = $PAUSE_SECONDS_UNAVAILABLE * $self->{'__paused'};
                $debug_msg = sprintf("service unavailable, pause for %.2f seconds",
                                     $retry_after);
        }
        
        $self->log()->debug($debug_msg);
        sleep($retry_after);
        
        # try, try again
        
        return $self->api_call($args);
}


sub upload {
        my $self = shift;
        my $args = shift;

        $args->{'auth_token'} = $self->{cfg}->param("flickr.auth_token");

        my $ua = Flickr::Upload->new({'key' => $self->{cfg}->param("flickr.api_key"),
                                      'secret' => $self->{cfg}->param("flickr.api_secret")});
        
        my $id = undef;

        eval {
                $id = $ua->upload(%$args);
        };

        if ($@){
                $self->log()->error("upload failed: $@");
                return 0;
        }

        return $id;
}


sub log {
        my $self = shift;
        return $self->{'__logger'};
}


return 1;

__END__