view release on metacpan or  search on metacpan

lib/Flickr/API.pm  view on Meta::CPAN

        $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) {

lib/Flickr/API.pm  view on Meta::CPAN

}

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