File Coverage

blib/lib/Flickr/API.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Flickr::API;

use strict;
use warnings;
use LWP::UserAgent;
use XML::Parser::Lite::Tree;
use XML::LibXML::Simple;
use Flickr::API::Request;
use Flickr::API::Response;
use Net::OAuth;
use Digest::MD5 qw(md5_hex);
use Scalar::Util qw(blessed);
use Encode qw(encode_utf8);
use Carp;
use Storable qw(store_fd retrieve_fd);

our @ISA = qw(LWP::UserAgent);

our $VERSION = '1.27';

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;

    #
    # If the options have consumer_key, handle as oauth
    #
    if (defined($options->{consumer_key})) {

        $self->{api_type} = 'oauth';
        $self->{rest_uri} = $options->{rest_uri} || 'https://api.flickr.com/services/rest/';
        $self->{auth_uri} = $options->{auth_uri} || 'https://api.flickr.com/services/oauth/authorize';

        if (defined($options->{consumer_secret})) {

            #
            # for the flickr api object
            #
            $self->{oauth_request}   = 'consumer';
            $self->{consumer_key}    = $options->{consumer_key};
            $self->{consumer_secret} = $options->{consumer_secret};
            $self->{unicode}         = $options->{unicode}           || 0;
            #
            # for Net::OAuth Consumer Requests
            #
            $self->{oauth}->{request_method}   = $options->{request_method}    || 'GET';
            $self->{oauth}->{request_url}      = $self->{rest_uri};
            $self->{oauth}->{consumer_secret}  = $options->{consumer_secret};
            $self->{oauth}->{consumer_key}     = $options->{consumer_key};
            $self->{oauth}->{nonce}            = $options->{nonce}             || _make_nonce();
            $self->{oauth}->{signature_method} = $options->{signature_method}  ||'HMAC-SHA1';
            $self->{oauth}->{timestamp}        = $options->{timestamp}         || time;
            $self->{oauth}->{version}          = '1.0';
            $self->{oauth}->{callback}         = $options->{callback};

        }
        else {

            carp "OAuth calls must have at least a consumer_key and a consumer_secret";
            $self->_set_status(0,"OAuth call without consumer_secret");

        }

        if (defined($options->{token}) && defined($options->{token_secret})) {

            #
            # If we have token/token secret then we are for protected resources
            #
            $self->{oauth}->{token_secret} = $options->{token_secret};
            $self->{oauth}->{token}        = $options->{token};
            $self->{oauth_request}         = 'protected resource';

        }

        #
        # Preserve request and access tokens
        #
        if (defined($options->{request_token}) and
            ref($options->{request_token}) eq 'Net::OAuth::V1_0A::RequestTokenResponse') {

            $self->{oauth}->{request_token} = $options->{request_token};

        }
        if (defined($options->{access_token}) and
            ref($options->{access_token}) eq 'Net::OAuth::AccessTokenResponse') {

            $self->{oauth}->{access_token} = $options->{access_token};

        }
    }

    else {

        $self->{api_type}   = 'flickr';
        $self->{api_key}     = $options->{key};
        $self->{api_secret}  = $options->{secret};
        $self->{rest_uri}    = $options->{rest_uri} || 'https://api.flickr.com/services/rest/';
        $self->{auth_uri}    = $options->{auth_uri} || 'https://api.flickr.com/services/auth/';
        $self->{unicode}     = $options->{unicode}  || 0;

        $self->{fauth}->{frob}    = $options->{frob};
        $self->{fauth}->{key}     = $options->{key};
        $self->{fauth}->{secret}  = $options->{secret};
        $self->{fauth}->{token}   = $options->{token};

        carp "You must pass an API key or a Consumer key to the constructor" unless defined $self->{api_key};

    }

    eval {
        require Compress::Zlib;

        $self->default_header('Accept-Encoding' => 'gzip');
    };

    bless $self, $class;
    $self->_clear_status();
    $self->_initialize();
    return $self;
}



#
# Execution Methods
#

sub execute_method {
    my ($self, $method, $args) = @_;
    my $request;

    if ($self->is_oauth) {

        #
        # Consumer Request Params
        #
        my $oauth = {};

        $oauth->{nonce}                   = _make_nonce();
        $oauth->{consumer_key}            =  $self->{oauth}->{consumer_key};
        $oauth->{consumer_secret}         =  $self->{oauth}->{consumer_secret};
        $oauth->{timestamp}               =  time;
        $oauth->{signature_method}        =  $self->{oauth}->{signature_method};
        $oauth->{version}                 =  $self->{oauth}->{version};

        if (defined($args->{'token'}) or defined($args->{'token_secret'})) {

            carp "\ntoken and token_secret must be specified in Flickr::API->new() and are being discarded\n";
            undef $args->{'token'};
            undef $args->{'token_secret'};
        }

        if (defined($args->{'consumer_key'}) or defined($args->{'consumer_secret'})) {

            carp "\nconsumer_key and consumer_secret must be specified in Flickr::API->new() and are being discarded\n";
            undef $args->{'consumer_key'};
            undef $args->{'consumer_secret'};
        }


        $oauth->{extra_params} = $args;
        $oauth->{extra_params}->{method}  =  $method;

        #
        # Protected resource params
        #
        if (defined($self->{oauth}->{token})) {

            $oauth->{token}             = $self->{oauth}->{token};
            $oauth->{token_secret}      = $self->{oauth}->{token_secret};

        }

        $request = Flickr::API::Request->new({
            'api_type'  => 'oauth',
            'method'    => $method,
            'args'      => $oauth,
            'rest_uri'  => $self->{rest_uri},
            'unicode'   => $self->{unicode},
        });
    }
    else {

        $request = Flickr::API::Request->new({
            'api_type' => 'flickr',
            'method'   => $method,
            'args'     => $args,
            'rest_uri' => $self->{rest_uri},
            'unicode'  => $self->{unicode},
        });
    }

    return $self->execute_request($request);

}

sub execute_request {
    my ($self, $request) = @_;

    $request->{api_args}->{method}  = $request->{api_method};

    unless ($self->is_oauth) { $request->{api_args}->{api_key} = $self->{api_key}; }

    if (defined($self->{api_secret}) && length($self->{api_secret})) {

       unless ($self->is_oauth) { $request->{api_args}->{api_sig} = $self->_sign_args($request->{api_args}); }

    }

    unless ($self->is_oauth) { $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 $xls  = XML::LibXML::Simple->new(ForceArray => 0);
    my $tree = XML::Parser::Lite::Tree::instance()->parse($content);

    my $hashref  = $xls->XMLin($content,KeyAttr => []);

    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,$hashref);
        return $response;
    }

    $response->set_fail(0, "API returned an invalid status code");
    return $response;
}


#
# Persistent config methods
#


#
# Method to return hash of important Flickr or OAuth parameters.
# OAuth can also export meaningful subsets of parameters based
# on OAuth message type.
#
sub export_config {
    my $self   = shift;
    my $type   = shift;
    my $params = shift;

    if ($self->is_oauth) {

        unless($params) { $params='do_it'; }

        my %oauth;

        if (defined($type)) {
            if ($params =~ m/^m.*/i) {
                %oauth = map { ($_) => undef }  @{Net::OAuth->request($type)->all_message_params()};
            }
            elsif ($params =~ m/^a.*/i) {
                %oauth = map { ($_) => undef }  @{Net::OAuth->request($type)->all_api_params()};
            }
            else {
                %oauth = map { ($_) => undef }  @{Net::OAuth->request($type)->all_params()};
            }
            foreach my $param (keys %oauth) {
                if (defined ($self->{oauth}->{$param})) { $oauth{$param} = $self->{oauth}->{$param}; }
            }
            return %oauth;
        }
        else {
            return %{$self->{oauth}};
        }
    }
    else {
        return %{$self->{fauth}};
    }

}

#
# Use perl core Storable to save important parameters.
#
sub export_storable_config {

    my $self = shift;
    my $file = shift;

    open my $EXPORT, '>', $file or croak "\nCannot open $file for write: $!\n";
    my %config = $self->export_config();
    store_fd(\%config, $EXPORT);
    close $EXPORT;
    return;
}

#
#  Use perl core Storable for re-vivifying an API object from saved parameters
#
sub import_storable_config {

    my $class = shift;
    my $file = shift;

    open my $IMPORT, '<', $file or croak "\nCannot open $file for read: $!\n";
    my $config_ref = retrieve_fd($IMPORT);
    close $IMPORT;
    my $api = $class->new($config_ref);
    return $api;
}



#
# Preauthorization Methods
#
# Handle request token requests (process: REQUEST TOKEN, authorize, access token)
#
sub oauth_request_token {

    my $self    = shift;
    my $options = shift;
    my %args    = %{$self->{oauth}};

    unless ($self->is_oauth) {
        carp "\noauth_request_token called for Non-OAuth Flickr::API object\n";
        return undef;
    }
    unless ($self->get_oauth_request_type() eq 'consumer') {
        croak "\noauth_request_token called using protected resource Flickr::API object\n";
    }

    $self->{oauth_request} = 'Request Token';
    $args{request_url}     = $options->{request_token_url} || 'https://api.flickr.com/services/oauth/request_token';
    $args{callback}        = $options->{callback} || 'https://127.0.0.1';

    $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;

    my $request = Net::OAuth->request('Request Token')->new(%args);

    $request->sign;

    my $response = $self->get($request->to_url);

    my $content  = $response->decoded_content();
    $content = $response->content() unless defined $content;

    if ($content =~ m/^oauth_problem=(.+)$/) {

        carp "\nRequest token not granted: '",$1,"'\n";
        $self->{oauth}->{request_token} = $1;
        return $1;
    }

    $self->{oauth}->{request_token}     = Net::OAuth->response('request token')->from_post_body($content);
    $self->{oauth}->{callback}          = $args{callback};
    return 'ok';
}


#
# Participate in authorization (process: request token, AUTHORIZE, access token)
#
sub oauth_authorize_uri {

    my $self    = shift;
    my $options = shift;

    unless ($self->is_oauth) {
        carp "oauth_authorize_uri called for Non-OAuth Flickr::API object";
        return undef;
    }
    my %args    = %{$self->{oauth}};

    $self->{oauth_request} = 'User Authentication';
    $args{perms}           = lc($options->{perms}) || 'read';

    carp "\nThe 'perms' parameter must be one of: read, write, delete\n"
        and return unless defined($args{perms}) && $args{perms} =~ /^(read|write|delete)$/;

    $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;

    return $self->{auth_uri} .
      '?oauth_token=' . $args{'request_token'}{'token'} .
      '&perms=' . $args{perms};

}

#
# flickr preauthorization
#

sub request_auth_url {
    my $self  = shift;
    my $perms = shift;
    my $frob  = shift;

    if ($self->is_oauth) {

        carp "request_auth_url called for an OAuth instantiated Flickr::API";
        return undef;

    }

    $perms = lc($perms);

    carp "\nThe 'perms' parameter must be one of: read, write, delete\n"
        and return unless defined($perms) && $perms =~ /^(read|write|delete)$/;

    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;
}


#
#  Access Token (post authorization) Methods
#
#  Handle access token requests (process: request token, authorize, ACCESS TOKEN)
#
sub oauth_access_token {

    my $self    = shift;
    my $options = shift;

    unless ($self->is_oauth) {
        carp "oauth_access_token called for Non-OAuth Flickr::API object";
        return undef;
    }
    if ($options->{token} ne $self->{oauth}->{request_token}->{token}) {

        carp "Request token in API does not match token for access token request";
        return undef;

    }

    #
    # Stuff the values for the Net::OAuth factory
    #
    $self->{oauth}->{verifier}     = $options->{verifier};
    $self->{oauth}->{token}        = $options->{token};
    $self->{oauth}->{token_secret} = $self->{oauth}->{request_token}->{token_secret};

    my %args   = %{$self->{oauth}};

    $args{request_url} = $options->{access_token_url} || 'https://api.flickr.com/services/oauth/access_token';

    $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;

    my $request = Net::OAuth->request('Access Token')->new(%args);

    $request->sign;

    my $response = $self->get($request->to_url);

    my $content  = $response->decoded_content();
    $content = $response->content() unless defined $content;

    if ($content =~ m/^oauth_problem=(.+)$/) {

        carp "\nAccess token not granted: '",$1,"'\n";
        $self->{oauth}->{access_token} = $1;

        delete $self->{oauth}->{token};        # Not saving problematic request token
        delete $self->{oauth}->{token_secret}; # token secret
        delete $self->{oauth}->{verifier};     # and verifier copies

        return $1;

    }

    $self->{oauth}->{access_token}  = Net::OAuth->response('access token')->from_post_body($content);
    $self->{oauth}->{token}         = $self->{oauth}->{access_token}->token();
    $self->{oauth}->{token_secret}  = $self->{oauth}->{access_token}->token_secret();

    delete $self->{oauth}->{request_token}; #No longer valid, anyway
    delete $self->{oauth}->{verifier};

    return 'ok';

}



sub flickr_access_token {
    my $self = shift;
    my $frob = shift;

    my $rsp = $self->execute_method('flickr.auth.getToken', {api_key => $self->{api_key}, frob => $frob });
    my $response_ref = $rsp->as_hash();

    $self->{fauth}->{frob} = $frob;

    $self->{token} = $response_ref->{auth}->{token};
    $self->{fauth}->{token} = $response_ref->{auth}->{token};

    $self->{fauth}->{user}  = $response_ref->{auth}->{user};

    return $response_ref->{stat};

}


#
#  Utility methods
#


sub is_oauth {
    my $self = shift;
    if (defined $self->{api_type} and $self->{api_type} eq 'oauth') {
        return 1;
    }
    else {
        return 0;
    }
}


sub get_oauth_request_type {
    my $self = shift;

    if (defined $self->{api_type} and $self->{api_type} eq 'oauth') {
        return $self->{oauth_request};
    }
    else {
        return undef;
    }
}

sub api_success {
    my $self = shift;

    return $self->{flickr}->{status}->{api_success};

}
sub api_message {
    my $self = shift;

    return $self->{flickr}->{status}->{api_message};
}


#
# Private methods
#

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

    if ($self->is_oauth) {

        carp "_sign_args called for an OAuth instantiated Flickr::API";
        return undef;

    }

    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 _find_tag {
    my ($self, $children) = @_;
    for my $child(@{$children}){
        return $child if $child->{type} eq 'element';
    }
    return {};
}

sub _make_nonce {

    return md5_hex(rand);

}
sub _export_api {
    my $self = shift;
    my $api  = {};

    $api->{oauth}       = $self->{oauth};
    $api->{fauth}       = $self->{fauth};
    $api->{flickr}      = $self->{flickr};

    $api->{api_type}    =  $self->{api_type};
    $api->{api_key}     =  $self->{api_key};
    $api->{api_secret}  =  $self->{api_secret};
    $api->{rest_uri}    =  $self->{rest_uri};
    $api->{unicode}     =  $self->{unicode};
    $api->{auth_uri}    =  $self->{auth_uri};

    return $api;
}


sub _initialize {

    my $self = shift;
    $self->_set_status(1,'Base API initialized');

}

sub _full_status {

    my $self = shift;
    return $self->{flickr}->{status};
}

sub _clear_status {

    my $self = shift;

    # the API status
    $self->_set_status(1,'');
    # the propagated response status
    $self->{flickr}->{status}->{_rc} = 0;
    $self->{flickr}->{status}->{success} = 1;         # initialize as successful
    $self->{flickr}->{status}->{error_code} = 0;
    $self->{flickr}->{status}->{error_message} = '';

    return;

}

sub _set_status {

    my $self  =  shift;
    my $good  =  shift;
    my $msg   =  shift;

    if ($good != 0) { $good = 1; }

    $self->{flickr}->{status}->{api_success} = $good;
    $self->{flickr}->{status}->{api_message} = $msg;

    return;
}



1;

__END__