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.28';

sub new {
    my ($class, $args) = @_;

    my $self;
    if ($args->{lwpobj}){
        my $lwpobj = $args->{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 args have consumer_key, handle as oauth
    #
    if (defined($args->{consumer_key})) {

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

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

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

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

        }

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

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

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

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

        }
    }

    else {

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

        if (defined($args->{key}) or defined ($self->{key})) {
            delete $args->{key};
            delete $self->{key};
            # Silenty switch key to api_key until a later release
            # carp "Argument 'key' is deprecated and has been changed to api_key";
        }

        if (defined ($args->{secret}) or defined ($self->{secret})) {
            delete $args->{secret};
            delete $self->{secret};
            # Silenty switch secret to api_secret until a later release
            # carp "Argument 'secret' is deprecated and has been changed to api_secret";
        }

        $self->{fauth}->{frob}       = $args->{frob};
        $self->{fauth}->{api_key}    = $self->{api_key};
        $self->{fauth}->{api_secret} = $self->{api_secret};
        $self->{fauth}->{token}      = $args->{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;
}



sub upload {
    my ($self, $args) = @_;
    my $upload;

    unless ($self->api_permissions() eq 'write' || $self->api_permissions() eq 'delete') {
        croak "insufficient permission for upload";
    }

    my %cfg = $self->export_config;
    $cfg{'request_url'} = $self->{upload_uri};

    $upload = Flickr::API::Upload->new({
        'photo'       => $args,
        'api'         => \%cfg,
        'api_type'    => $self->api_type(),
    });

    my $response = $self->request($upload);
    bless $response, 'Flickr::API::Response';

    $response->init_flickr();

    if ($response->{_rc} != 200){
        $response->set_fail(0, "Upload 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, "Upload 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, "Upload 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, $type, $params) = @_;

    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,$file) = @_;

    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,$file) = @_;

    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, $args) = @_;

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

    unless ($self->is_oauth) {
        carp "\noauth_request_token called for Non-OAuth Flickr::API object\n";
        return;
    }
    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';
    $oauth{request_url}    = $args->{request_token_url} || 'https://api.flickr.com/services/oauth/request_token';
    $oauth{callback}       = $args->{callback} || 'https://127.0.0.1';

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

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

    $orequest->sign;

    my $response = $self->get($orequest->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}          = $oauth{callback};
    return 'ok';
}

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

    my ($self, $args) = @_;

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

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

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

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

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

}

#
# flickr preauthorization
#

sub request_auth_url {
    my ($self, $perms, $frob) = @_;

    if ($self->is_oauth) {

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

    }

    $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 unless defined $self->{api_secret} && length $self->{api_secret};

    my %fauth = (
        'api_key' => $self->{api_key},
        'perms'   => $perms
    );

    if ($frob) {
        $fauth{frob} = $frob;
    }

    my $sig = $self->_sign_args(\%fauth);
    $fauth{api_sig} = $sig;

    my $uri = URI->new($self->{auth_uri});
    $uri->query_form(%fauth);

    return $uri;
}


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

    my ($self, $args) = @_;

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

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

    }

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

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

    $oauth{request_url} = $args->{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(%oauth);

    $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,$frob) = @_;

    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) = @_;
    if (defined $self->{api_type} and $self->{api_type} eq 'oauth') {
        return 1;
    }
    else {
        return 0;
    }
}


sub get_oauth_request_type {
    my ($self) = @_;

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

sub api_type {
    my ($self) = @_;

    return $self->{api_type};

}


sub api_success {
    my ($self) = @_;

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

}




sub api_message {
   my ($self) = @_;

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


sub api_permissions {
    my ($self) = @_;
    my $rsp;
    my $check;
    my $retval;

    if ($self->is_oauth) {

        if (defined($self->{oauth}->{perms})) {

            $self->_set_status(1,"Permissions retrieved from config.");

        }
        else {

            $self->{oauth}->{perms} = 'none'; #preload no perms

            $rsp = $self->execute_method('flickr.auth.oauth.checkToken');

            if (!$rsp->success()) {

                $rsp->_propagate_status($self->{flickr}->{status});

                carp "\nUnable to validate OAuth token. Flickr error: ",
                    $self->{flickr}->{status}->{error_code}," - \"",
                    $self->{flickr}->{status}->{error_message},"\" \n";
                delete $self->{oauth}->{perms};
                $self->_set_status(0,"Unable to validate OAuth token, Flickr API call not successful.");

            }
            else {

                $check = $rsp->as_hash();

                $self->{oauth}->{perms} = $check->{oauth}->{perms};
                $self->_set_status(1,"Permissions retrieved from Flickr.");

            }
        } # else not cached

        $retval = $self->{oauth}->{perms};

    } # is_oauth
    else { # is_flickr

        if (defined($self->{fauth}->{perms})) {

             $self->_set_status(1,"Permissions retrieved from config.");

        }
        else {

            $self->{fauth}->{perms} = 'none'; #preload no perms
            $rsp = $self->execute_method('flickr.auth.checkToken',{'auth_token' => $self->{fauth}->{token}});

            if (!$rsp->success()) {

                $rsp->_propagate_status($self->{flickr}->{status});

                carp "\nUnable to validate Flickr token. Flickr error: ",
                    $self->{flickr}->{status}->{error_code}," - \"",
                    $self->{flickr}->{status}->{error_message},"\" \n";
                delete $self->{fauth}->{perms};
                $self->_set_status(0,"Unable to validate Flickr token, Flickr API call not successful.");

            }
            else {

                $check = $rsp->as_hash();

                $self->{fauth}->{perms} = $check->{auth}->{perms};
                $self->_set_status(1,"Permissions retrieved from Flickr.");
           }
        } # else not cached

        $retval = $self->{fauth}->{perms};

    } # else is_flickr


    return $retval;

}


#
# Private methods
#

sub _sign_args {
    my ($self, $args) = @_;

    if ($self->is_oauth) {

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

    }

    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) = @_;
    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};
    $api->{upload_uri}  =  $self->{upload_uri};

    return $api;
}


sub _initialize {

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

}

sub _full_status {

    my ($self) = @_;
    return $self->{flickr}->{status};
}

sub _clear_status {

    my ($self) = @_;

    # 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, $good, $msg) = @_;

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

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

    return;
}



1;

__END__