Flickr-API-1.29/0000755000175000017500000000000014567144144012726 5ustar ubuntuubuntuFlickr-API-1.29/README.subclasses0000644000175000017500000001066714567143531015765 0ustar ubuntuubuntu ====================== Flickr::API Subclasses ====================== The Flickr::API has a number of derived subclasses to aid in the use of the various sections of Flickr's API as described on https://www.flickr.com/services/api/ A NOTE ON TESTING These subclasses rely on an existing OAuth configuration as is used by earlier tests. When you test them, you will need to have done the `make test' with MAKETEST_OAUTH_CFG=config_file specified. A NOTE ON AUTHENTICATION Flickr::API subclasses don't use Flickr's original (deprecated) authentication. You will need to use OAuth. On the other hand, some methods don't require authentication, just changing key to consumer_key and secret to consumer_secret should work on these. The Flickr::API is derived from LWP::UserAgent. It adds three main keys to the LWP::UserAgent: $self->{flickr}, $self->{oauth} and $self->{fauth}. The oauth key contains the key/value pairs needed to handle Flickr's OAuth authentication. An OAuth section will look something like: 'oauth' => { 'token' => '12345678909876543-b77c2eface79e3d3', 'signature_method' => 'HMAC-SHA1', 'request_method' => 'GET', 'consumer_key' => '123beeffaceade94a0a3611ca1f5a5e0', 'access_token' => bless( { 'token_secret' => 'beefcafe349be12d', 'token' => '12345678909876543-b77c2eface79e3d3', 'extra_params' => { 'fullname' => 'ASCII, Character', 'user_nsid' => '1234567890@N00', 'username' => 'abcdefg' }, 'from_hash' => 1 }, 'Net::OAuth::AccessTokenResponse' ), 'consumer_secret' => '64beefca1f7eecad', 'request_url' => 'https://api.flickr.com/services/rest/', 'callback' => 'https://127.0.0.1', 'nonce' => '3c0f553fa1eba3b1c62cfabf2ee9afaa', 'timestamp' => 1438806177, 'version' => '1.0', 'token_secret' => 'beefcafe349be12d' } The fauth key contains the key/value pairs needed to handle Flickr's (original but deprecated) authentication. An FAuth section will look something like: 'fauth' => { 'frob' => '34567890987654321-78faced1b7e8eda3-1234542', 'token' => '12345678909876543-42b0ceded01f65f5', 'secret' => '64beefca1f7eecad', 'key' => '123beeffaceade94a0a3611ca1f5a5e0' }, The flickr key contains everything else Flickr. This is where values used by the various classes derived from Flickr::API will be stored. 'flickr' => { 'status' => { '_rc' => 0, 'error_code' => 0, 'success' => 1, 'error_message' => '' } }, In addition, and to help maintain continuity with earlier versions, the following individual keys are used in the Flickr::API 'api_key' => '123beeffaceade94a0a3611ca1f5a5e0' 'api_secret' => '64beefca1f7eecad', 'unicode' => 0, 'rest_uri' => 'https://api.flickr.com/services/rest/', 'auth_uri' => 'https://api.flickr.com/services/auth/', 'api_type' => 'oauth', Flickr::API::Cameras ==================== Flickr::API::Cameras is a subclass of Flickr::API with some additions for using Flickr's flickr.cameras methods: brands_list - returns a list of camera brands as an array brands_hash - returns a list of camera brands as a hashref get_cameras - returns a hashref of camera models by the specified brand as a hashref Flickr::API::Reflection ======================= Flickr::API::Reflection is a subclass of Flickr::API with some (hopefully) useful additions for using Flickr's flickr.reflection methods. methods_list - returns a list of Flickr's methods as an array methods_hash - returns a list of Flickr's methods as a hashref get_method - returns the description of a specified method as a hashref COPYRIGHT AND LICENSE Copyright (C) 2015 Louis B. Moore License: Perl Artistic License 2.0 Flickr-API-1.29/t/0000755000175000017500000000000014567144144013171 5ustar ubuntuubuntuFlickr-API-1.29/t/04-oauth_requesttoken.t0000644000175000017500000000432614567143531017534 0ustar ubuntuubuntuuse strict; use warnings; use Test::More; use Data::Dumper; use Storable; use Flickr::API; if (defined($ENV{MAKETEST_OAUTH_CFG})) { plan( tests => 11 ); } else { plan(skip_all => 'These tests require that MAKETEST_OAUTH_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_OAUTH_CFG}; my $config_ref; my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, readable?"); SKIP: { skip "Skipping request token tests, oauth config isn't there or is not readable", 10 if $fileflag == 0; my $api = Flickr::API->import_storable_config($config_file); isa_ok($api, 'Flickr::API'); is($api->is_oauth, 1, 'Does Flickr::API object identify as OAuth'); SKIP: { skip "Skipping request token tests, oauth config already has accesstoken", 8 if $api->get_oauth_request_type() =~ m/protected resource/i; is($api->get_oauth_request_type(), 'consumer', 'Does Flickr::API object identify as consumer request'); my $request_req = $api->oauth_request_token({'callback' => $config_ref->{callback}}); is($request_req, 'ok', "Did oauth_request_token complete successfully"); SKIP: { skip "Skipping request token tests, oauth_request_token returns $request_req", 6 if $request_req ne 'ok'; my %config = $api->export_config(); $config{'continue-to-access'} = $request_req; $fileflag=0; if (-w $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, writeable?"); $api->export_storable_config($config_file); my $api2 = Flickr::API->import_storable_config($config_file); isa_ok($api2, 'Flickr::API'); is_deeply($api2->{oauth}, $api->{oauth}, "Did import_storable_config get back the config we stored"); isa_ok($api2->{oauth}->{request_token}, 'Net::OAuth::V1_0A::RequestTokenResponse'); is($api->{oauth}->{request_token}->{callback_confirmed}, 'true', 'Is the callback confirmed in the request token'); #10 like($api2->{oauth}->{request_token}->{token_secret}, qr/[0-9a-f]+/i, 'Was a request token received and are we good to go to to access token tests?'); print "\n\nOAuth Config:\n\n",Dumper($api2->{oauth}),"\n\n"; } } } exit; # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/06-oauth-authenticated-methods.t0000644000175000017500000000660514567143531021210 0ustar ubuntuubuntuuse strict; use warnings; use Test::More tests => 17; use Storable; use Flickr::API; my $config_file; if (defined($ENV{MAKETEST_OAUTH_CFG})) { $config_file = $ENV{MAKETEST_OAUTH_CFG}; } else { diag( 'No MAKETEST_OAUTH_CFG, shallow tests only' ); $config_file = '/no/file/by/this/name.is.there?'; } my $config_ref; my $api; $api = Flickr::API->new( { consumer_key => '012345beefcafe543210', consumer_secret => 'a234b345c456feed', } ); isa_ok($api, 'Flickr::API'); my $fileflag=0; if ($config_file and -r $config_file) { $fileflag = 1; } SKIP: { skip "Skipping authentication tests, oauth config isn't there or is not readable", 16 if $fileflag == 0; is( $fileflag, 1, 'Is the config file: $config_file, readable?' ); $api = Flickr::API->import_storable_config($config_file); isa_ok($api, 'Flickr::API'); is( $api->is_oauth, 1, 'Does Flickr::API object identify as OAuth'); like( $api->{oauth}->{consumer_key}, qr/[0-9a-f]+/i, "Did we get a consumer key from $config_file" ); like( $api->{oauth}->{consumer_secret}, qr/[0-9a-f]+/i, "Did we get a consumer secret from $config_file" ); like( $api->{oauth}->{token}, qr/^[0-9]+-[0-9a-f]+$/i, "Did we get an access_token token from $config_file" ); like( $api->{oauth}->{token_secret}, qr/^[0-9a-f]+$/i, "Did we get an access_token token_secret from $config_file" ); my $proceed = 0; if ($api->{oauth}->{token} =~ m/^[0-9]+-[0-9a-f]+$/i and $api->{oauth}->{token_secret} =~ m/^[0-9a-f]+$/i) { $proceed = 1; } SKIP: { skip "Skipping authentication tests, oauth access token seems wrong", 9 if $proceed == 0; my $rsp = $api->execute_method('flickr.auth.oauth.checkToken'); my $ref = $rsp->as_hash(); is( $ref->{stat}, 'ok', 'Did flickr.auth.oauth.checkToken complete sucessfully' ); isnt( $ref->{oauth}->{user}->{nsid}, undef, 'Did flickr.auth.oauth.checkToken return nsid' ); isnt( $ref->{oauth}->{user}->{username}, undef, 'Did flickr.auth.oauth.checkToken return username' ); $rsp = $api->execute_method('flickr.test.login'); $ref = $rsp->as_hash(); is( $ref->{stat}, 'ok', 'Did flickr.test.login complete sucessfully' ); isnt( $ref->{user}->{id}, undef, 'Did flickr.test.login return id' ); isnt( $ref->{user}->{username}, undef, 'Did flickr.test.login return username' ); $rsp = $api->execute_method('flickr.prefs.getPrivacy'); $ref = $rsp->as_hash; is( $ref->{stat}, 'ok', 'Did flickr.prefs.getPrivacy complete sucessfully' ); isnt( $ref->{person}->{nsid}, undef, 'Did flickr.prefs.getPrivacy return nsid' ); isnt( $ref->{person}->{privacy}, undef, 'Did flickr.prefs.getPrivacy return privacy' ); } } exit; __END__ # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/05-flickr_authentication.t0000644000175000017500000001046114567143531020152 0ustar ubuntuubuntuuse strict; use warnings; use Test::More; use Data::Dumper; use Storable; use Term::ReadLine; use Flickr::API; if (defined($ENV{MAKETEST_FLICKR_AUTHED})) { plan(skip_all => 'These tests are being bypassed because MAKETEST_FLICKR_AUTHED is defined, see README.'); } if (defined($ENV{MAKETEST_FLICKR_CFG})) { plan( tests => 15 ); } else { plan(skip_all => 'These tests require that MAKETEST_FLICKR_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_FLICKR_CFG}; my $useperms = 'read'; if (defined($ENV{MAKETEST_PERMS}) && $ENV{MAKETEST_PERMS} =~ /^(read|write|delete)$/) { $useperms = $ENV{MAKETEST_PERMS}; } my $api; my $term; my $key='fail'; my $frob; my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, readable?"); SKIP: { skip "Skipping authentication tests, flickr config isn't there or is not readable", 14 if $fileflag == 0; $term = Term::ReadLine->new('Testing Flickr::API'); $term->ornaments(0); $api = Flickr::API->import_storable_config($config_file); isa_ok($api, 'Flickr::API'); is($api->is_oauth, 0, 'Does Flickr::API object identify as Flickr'); like($api->{api_key}, qr/[0-9a-f]+/i, "Did we get an api key from $config_file"); like($api->{api_secret}, qr/[0-9a-f]+/i, "Did we get an api secret from $config_file"); SKIP: { skip "Skip getting a frob, we already have " . $api->{fauth}->{frob} , 1 if (defined($api->{fauth}->{frob}) and $api->{fauth}->{frob} =~ m/^[0-9a-f\-]+/i); my $url = $api->request_auth_url($useperms); my $uri = $url->as_string(); my $which_rl = $term->ReadLine; if ($which_rl eq "Term::ReadLine::Perl" or $which_rl eq "Term::ReadLine::Perl5") { diag "\n\nTerm::ReadLine::Perl and Term::ReadLine::Perl5 may display prompts" . "\nincorrectly. If this is the case for you, try adding \"PERL_RL=Stub\"" . "\nto the environment variables passed in with make test\n\n"; } my $prompt = "\n\n$uri\n\n" . "Copy the above url to a browser, and authenticate with Flickr\n" . "Press [ENTER] once you get the redirect (or error): "; my $input = $term->readline($prompt); $prompt = "\n\nCopy the redirect URL from your browser and enter it\n" . "(or if there was an error, or a non-web-based API Key, just press [Enter]\n" . "\nURL Here: "; $input = $term->readline($prompt); chomp($input); SKIP: { skip "Skip frob input test, no frob input. Desktop API?", 1 unless $input =~ m/.*frob=.*/; my ($callback_returned,$frob_received) = split(/\?/,$input); ($key,$frob) = split(/\=/,$frob_received); is($key, 'frob', "Was the returned key 'frob'"); } } if ( defined($key) and $key ne 'frob' and defined($api->{fauth}->{frob}) and $api->{fauth}->{frob} =~ m/^[0-9a-f\-]+/i) { $key = 'frob'; $frob = $api->{fauth}->{frob}; } SKIP: { skip "Skip frob to token tests, no frob received. Desktop API?", 9 if $key ne 'frob'; like($frob, qr/^[0-9a-f\-]+/i, "Is the returned frob, frob-shaped"); SKIP: { skip "Skip getting a token, we already have " . $api->{fauth}->{token} , 3 if defined($api->{fauth}->{token}) and $api->{fauth}->{token} =~ m/^[0-9a-f\-]+/i; my $rc = $api->flickr_access_token($frob); is($rc, 'ok', 'Was flickr_access_token successful'); like($api->{fauth}->{token}, qr/^[0-9a-f\-]+/i, 'Is the token received token shaped'); like($api->{fauth}->{user}->{nsid}, qr/^[0-9]+\@[0-9a-z]/i, 'Did we get back an nsid'); } $fileflag=0; if (-w $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, writable?"); SKIP: { skip "Skip saving of flickr config, ",$config_file," is not writeable", 4 if $fileflag == 0; $api->export_storable_config($config_file); my $api2 = Flickr::API->import_storable_config($config_file); isa_ok($api2, 'Flickr::API'); is($api2->{api_key}, $api->{api_key}, 'were we able to import our api key'); is($api2->{api_secret}, $api->{api_secret}, 'were we able to import our api secret'); is($api2->{fauth}->{token},$api->{fauth}->{token}, 'What about the token'); } } } # skipping auth tests exit; __END__ # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/05-oauth_authentication.t0000644000175000017500000001345614567143531020027 0ustar ubuntuubuntuuse strict; use warnings; use Test::More; use Term::ReadLine; use Flickr::API; if (defined($ENV{MAKETEST_OAUTH_AUTHED})) { plan(skip_all => 'These tests are being bypassed because MAKETEST_OAUTH_AUTHED is defined, see README.'); } if (defined($ENV{MAKETEST_OAUTH_CFG})) { plan( tests => 21 ); } else { plan(skip_all => 'These tests require that MAKETEST_OAUTH_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_OAUTH_CFG}; my $config_ref; my $useperms = 'read'; if (defined($ENV{MAKETEST_PERMS}) && $ENV{MAKETEST_PERMS} =~ /^(read|write|delete)$/) { $useperms = $ENV{MAKETEST_PERMS}; } my $api; my $term; $term = Term::ReadLine->new('Testing Flickr::API'); $term->ornaments(0); my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, readable?"); SKIP: { skip "Skipping authentication tests, oauth config isn't there or is not readable", 20 if $fileflag == 0; $api = Flickr::API->import_storable_config($config_file); isa_ok($api, 'Flickr::API'); is($api->is_oauth, 1, 'Does Flickr::API object identify as OAuth'); SKIP: { skip "Skip request token and authentication tests, access token exists", 18 if (defined($api->{oauth}->{token}) and $api->{oauth}->{token} =~ /^[0-9]+-[0-9a-f]+$/); like($api->{oauth}->{consumer_key}, qr/[0-9a-f]+/i, "Did we get a consumer key from $config_file"); like($api->{oauth}->{consumer_secret}, qr/[0-9a-f]+/i, "Did we get a consumer secret from $config_file"); like($api->{oauth}->{request_token}->{token}, qr/^[0-9]+-[0-9a-f]+$/i, "Did we get a request_token token from $config_file"); like($api->{oauth}->{request_token}->{token_secret}, qr/^[0-9a-f]+$/i, "Did we get a request_token token_secret from $config_file"); my $proceed = 0; if ($api->{oauth}->{request_token}->{token} =~ m/^[0-9]+-[0-9a-f]+$/i and $api->{oauth}->{request_token}->{token_secret} =~ m/^[0-9a-f]+$/i) { $proceed = 1; } SKIP: { skip "Skipping authentication tests, oauth request token seems wrong", 14 if $proceed == 0; my $which_rl = $term->ReadLine; if ($which_rl eq "Term::ReadLine::Perl" or $which_rl eq "Term::ReadLine::Perl5") { diag "\n\nTerm::ReadLine::Perl and Term::ReadLine::Perl5 may display prompts" . "\nincorrectly. If this is the case for you, try adding \"PERL_RL=Stub\"" . "\nto the environment variables passed in with make test\n\n"; } my $uri = $api->oauth_authorize_uri({ 'perms' => $useperms }); my $prompt = "\n\n$uri\n\n" . "Copy the above url to a browser, and authenticate with Flickr\n" . "Press [ENTER] once you get the redirect (or error): "; my $input = $term->readline($prompt); $prompt = "\n\nCopy the redirect URL from your browser and enter it\n" . "(or if there was an error just press [Enter]\n" . "\nURL Here: "; $input = $term->readline($prompt); chomp($input); my ($callback_returned,$token_received) = split(/\?/,$input); my (@parms) = split(/\&/,$token_received); like($callback_returned, qr/^$api->{oauth}->{callback}/i, "Was the redirect to the callback"); my %request_token; foreach my $pair (@parms) { my ($key,$val) = split(/=/,$pair); $key =~ s/oauth_//; $request_token{$key}=$val; } like($request_token{token}, qr/^[0-9]+-[0-9a-f]+/i, "Is the returned token, token-shaped"); like($request_token{verifier}, qr/^[0-9a-f]+/i, "Is the returned token verifier a hex number"); my $access_req = $api->oauth_access_token(\%request_token); is($access_req, 'ok', "Did oauth_access_token complete successfully"); isa_ok($api->{oauth}->{access_token}, 'Net::OAuth::AccessTokenResponse'); my $access_token = $api->{oauth}->{access_token}->token(); my $access_secret = $api->{oauth}->{access_token}->token_secret(); like($access_token, qr/^[0-9]+-[0-9a-f]+/i, "Is the access token, token-shaped"); like($access_secret, qr/^[0-9a-f]+/i, "Is the access token secret a hex number"); SKIP: { skip "Skipping save of access token bearing api because access token wasn't received", 7 if !$access_token; $fileflag=0; if (-w $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, writeable?"); $api->export_storable_config($config_file); $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, readable?"); my $api2 = Flickr::API->import_storable_config($config_file); isa_ok($api2, 'Flickr::API'); is_deeply($api2->{oauth}->{access_token}, $api->{oauth}->{access_token}, "Did import_storable_config get back the access token we stored"); isa_ok($api2->{oauth}->{access_token}, 'Net::OAuth::AccessTokenResponse'); my $access_token2 = $api2->{oauth}->{access_token}->token(); my $access_secret2 = $api2->{oauth}->{access_token}->token_secret(); like($access_token2, qr/^[0-9]+-[0-9a-f]+/i, "Is the access token, token-shaped"); like($access_secret2, qr/^[0-9a-f]+/i, "Is the access token secret a hex number"); } } } } exit; __END__ # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/03-flickr_api.t0000644000175000017500000000471014567143531015702 0ustar ubuntuubuntuuse strict; use warnings; use Test::More; use Storable; use Flickr::API; if (defined($ENV{MAKETEST_FLICKR_CFG})) { plan( tests => 11 ); } else { plan(skip_all => 'These tests require that MAKETEST_FLICKR_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_FLICKR_CFG}; my $config_ref; my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, readable?"); SKIP: { skip "Skipping api tests, Flickr config isn't there or is not readable", 9 if $fileflag == 0; $config_ref = retrieve($config_file); like($config_ref->{api_key}, qr/[0-9a-f]+/i, "Did we get a hexadecimal api key in the config"); like($config_ref->{api_secret}, qr/[0-9a-f]+/i, "Did we get a hexadecimal api secret in the config"); my $api; my $rsp; my $ref; $api= Flickr::API->new({ 'api_key' => $config_ref->{api_key}, 'api_secret' => $config_ref->{api_secret}, }); isa_ok($api, 'Flickr::API'); is($api->is_oauth, 0, 'Does Flickr::API object identify as Flickr authentication'); $rsp = $api->execute_method('fake.method', {}); isa_ok $rsp, 'Flickr::API::Response'; SKIP: { skip "skipping error code check, since we couldn't reach the API", 1 if $rsp->rc() ne '200'; # this error code may change in future! is($rsp->error_code(), 212, 'checking the error code for "method not found"'); } ################################################## # # check the 'format not found' error is working # $rsp = $api->execute_method('flickr.test.echo', {format => 'fake'}); SKIP: { skip "skipping error code check, since we couldn't reach the API", 1 if $rsp->rc() ne '200'; is($rsp->error_code(), 111, 'checking the error code for "format not found"'); } $rsp = $api->execute_method('flickr.reflection.getMethods'); $ref = $rsp->as_hash(); SKIP: { skip "skipping method call check, since we couldn't reach the API", 1 if $rsp->rc() ne '200'; is($ref->{'stat'}, 'ok', 'Check for ok status from flickr.reflection.getMethods'); } undef $rsp; undef $ref; $rsp = $api->execute_method('flickr.test.echo', { 'foo' => 'barred' } ); $ref = $rsp->as_hash(); SKIP: { skip "skipping method call check, since we couldn't reach the API", 2 if $rsp->rc() ne '200'; is($ref->{'stat'}, 'ok', 'Check for ok status from flickr.test.echo'); is($ref->{'foo'}, 'barred', 'Check result from flickr.test.echo'); } } exit; # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/02-flickr_api.t0000644000175000017500000000372614567143531015707 0ustar ubuntuubuntuuse strict; use warnings; use Test::More tests => 15; use File::Temp (); use Flickr::API; ######################################################## # # create a generic flickr api with oauth consumer object # my $key = 'My_Made_up_Key'; my $secret = 'My_little_secret'; my $api = Flickr::API->new({ 'key' => $key, 'api_secret' => $secret, }); isa_ok($api, 'Flickr::API'); is($api->is_oauth, 0, 'Does Flickr::API object identify as Flickr authentication'); is($api->api_type, 'flickr', 'Does Flickr::API object correctly specify its type as flickr'); ######################################################## # # make sure it returns the required api params # my %config = $api->export_config(); is($config{'api_key'}, $key, 'Did export_config return the api_key'); is ($config{'key'}, undef, 'Did constructor remove the older key in favor of api_key'); is($config{'api_secret'}, $secret, 'Did export_config return the api secret'); is ($config{'secret'}, undef, 'Did constructor remove the older secret in favor of api_secret'); is($config{'frob'}, undef, 'Did export_config return undef for undefined frob'); is($config{'token'}, undef, 'Did export_config return undef for undefined token'); ######################################################## # # # my $FH = File::Temp->new(); my $config_file = $FH->filename; $api->export_storable_config($config_file); my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Did export_storable_config produce a readable config"); my $api2 = Flickr::API->import_storable_config($config_file); isa_ok($api2, 'Flickr::API'); is($api2->{api_key}, $key, 'were we able to import our api key'); is($api2->{key}, undef, "did we sucessfully shake deprecated 'key' argument"); is($api2->{api_secret}, $secret, 'were we able to import our api secret'); is($api2->{secret}, undef, "did we sucessfully shake deprecated 'secret' argument"); exit; # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/08-cameras.t0000644000175000017500000000407214567143531015220 0ustar ubuntuubuntuuse strict; use warnings; use Test::More; use Flickr::API::Cameras; if (defined($ENV{MAKETEST_OAUTH_CFG})) { plan( tests => 12 ); } else { plan(skip_all => 'Cameras tests require that MAKETEST_OAUTH_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_OAUTH_CFG}; my $config_ref; my $api; my $papi; my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, readable?"); SKIP: { skip "Skipping oauth cameras tests, oauth config isn't there or is not readable", 14 if $fileflag == 0; $api = Flickr::API::Cameras->import_storable_config($config_file); isa_ok($api, 'Flickr::API::Cameras'); is($api->is_oauth, 1, 'Does this Flickr::API::Cameras object identify as OAuth'); is($api->api_success, 1, 'Did cameras api initialize successful'); my $brands = $api->brands_list(); SKIP: { skip "Skipping brands_list tests, not able to reach the API or received error", 3, if !$api->api_success; like($brands->[0], qr/^[a-zA-Z]+$/, "Does the list appear to have a brand"); my %check = map {$_ => 1} @{$brands}; is( $check{'Canon'}, 1, 'Was Canon in the brands_list'); is( $check{'Olympus'}, 1, 'Was Olympus in the brands_list'); } my $hashcameras = $api->brands_hash(); SKIP: { skip "Skipping brands_hash tests, not able to reach the API or received error", 2, if !$api->api_success; is( $hashcameras->{'Nikon'}, 1, 'Was Nikon in the cameras_hash'); is( $hashcameras->{'Olympus'}, 1, 'Was Olympus in the cameras_hash'); } my $cameras = $api->get_cameras('You_call_THIS_a_camera_Brand'); is( $api->api_success, 0, 'Did we fail on a fake brand as expected'); $cameras = $api->get_cameras('Leica'); is( $api->api_success, 1, 'Were we successful as expected'); my @cam_ids = keys(%{$cameras->{'Leica'}}); ok( $#cam_ids > 0, 'Did we get a list of camera models'); } exit; __END__ # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/02-oauth_api.t0000644000175000017500000001237314567143531015553 0ustar ubuntuubuntuuse strict; use warnings; use Test::More tests => 32; use Test::Script; use File::Temp (); use Flickr::API; ######################################################## # # create a generic flickr api with oauth consumer object # my $key = 'My_Made_up_Key'; my $secret = 'My_little_secret'; my $api = Flickr::API->new({ 'consumer_key' => $key, 'consumer_secret' => $secret, }); isa_ok($api, 'Flickr::API'); is($api->is_oauth, 1, 'Does Flickr::API object identify as OAuth'); is($api->get_oauth_request_type(), 'consumer', 'Does Flickr::API object identify as consumer request'); is($api->api_type, 'oauth', 'Does Flickr::API object correctly specify its type as oauth'); ######################################################## # # make sure it returns the required message params # my %config = $api->export_config('consumer', 'message'); is($config{'consumer_key'}, $key, 'Did export_config return the consumer_key in consumer/message request'); is($config{'signature_method'}, 'HMAC-SHA1', 'Did export_config return the correct signature_method in consumer/message request'); like($config{'nonce'}, qr/[0-9a-f]+/i, 'Did export_config return a nonce in consumer/message request'); like($config{'timestamp'}, qr/[0-9]+/i, 'Did export_config return a timestamp in consumer/message request'); ######################################################## # # make sure it returns the required api params # undef %config; %config = $api->export_config('consumer', 'api'); is($config{'consumer_secret'}, $secret, 'Did export_config return the consumer_secret in consumer/api request'); is($config{'request_method'}, 'GET', 'Did export_config return the correct request_method in consumer/api request'); is($config{'request_url'}, 'https://api.flickr.com/services/rest/', 'Did export_config return the correct request_url in consumer/api request'); undef %config; undef $api; ################################################################## # # create a generic flickr api with oauth protected resource object # my $token = 'a-fake-oauth-token-for-generic-tests'; my $token_secret = 'my-embarassing-secret-exposed'; $api = Flickr::API->new({ 'consumer_key' => $key, 'consumer_secret' => $secret, 'token' => $token, 'token_secret' => $token_secret, }); isa_ok($api, 'Flickr::API'); is($api->is_oauth, 1, 'Does Flickr::API object identify as OAuth'); is($api->get_oauth_request_type(), 'protected resource', 'Does Flickr::API object identify as protected resource request'); ################################################################## # # make sure it also returns the required message params # %config = $api->export_config('protected resource', 'message'); is($config{'consumer_key'}, $key, 'Did export_config return the consumer_key in protected resource/message request'); is($config{'token'}, $token, 'Did export_config return the token in protected resource/message request'); is($config{'signature_method'}, 'HMAC-SHA1', 'Did export_config return the correct signature_method in protected resource/message request'); like($config{'nonce'}, qr/[0-9a-f]+/i, 'Did export_config return a nonce in protected resource/message request'); like($config{'timestamp'}, qr/[0-9]+/i, 'Did export_config return a timestamp in protected resource/message request'); ######################################################## # # make sure it also returns the required api params # undef %config; %config = $api->export_config('protected resource', 'api'); is($config{'consumer_secret'}, $secret, 'Did export_config return the consumer_secret in protected resource/api request'); is($config{'token_secret'}, $token_secret, 'Did export_config return the token_secret in protected resource/api request'); is($config{'request_method'}, 'GET', 'Did export_config return the correct request_method in protected resource/api request'); is($config{'request_url'}, 'https://api.flickr.com/services/rest/', 'Did export_config return the correct request_url in protected resource/api request'); my $FH = File::Temp->new(); my $fname = $FH->filename; $api->export_storable_config($fname); my $fileflag=0; if (-r $fname) { $fileflag = 1; } is($fileflag, 1, "Did export_storable_config produce a readable config"); my $api2 = Flickr::API->import_storable_config($fname); isa_ok($api2, 'Flickr::API'); is_deeply($api2->{oauth}, $api->{oauth}, "Did import_storable_config get back the config we stored"); script_compiles('script/flickr_make_stored_config.pl','Does flickr_make_stored_config.pl compile'); script_compiles('script/flickr_dump_stored_config.pl','Does flickr_dump_stored_config.pl compile'); script_compiles('script/flickr_make_test_values.pl','Does flickr_make_test_values.pl compile'); my @runtime = ('script/flickr_dump_stored_config.pl', '--config_in='.$fname); script_runs(\@runtime, "Did flickr_dump_stored_config.pl run"); ######################################################## # # check private method # my $apiex = $api->_export_api(); is($apiex->{'oauth'}->{'consumer_key'}, $key, 'Did _export_api return the consumer_key when asked'); my $nonce = $api->_make_nonce(); like( $nonce, qr/[0-9a-f]+/i, 'Did _make_nonce return a nonce when asked'); exit; # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/07-reflection.t0000644000175000017500000000476314567143531015745 0ustar ubuntuubuntuuse strict; use warnings; use Test::More; use Flickr::API::Reflection; if (defined($ENV{MAKETEST_OAUTH_CFG})) { plan( tests => 13 ); } else { plan(skip_all => 'Reflection tests require that MAKETEST_OAUTH_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_OAUTH_CFG}; my $config_ref; my $api; my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, readable?"); SKIP: { skip "Skipping oauth reflection tests, oauth config isn't there or is not readable", 12 if $fileflag == 0; $api = Flickr::API::Reflection->import_storable_config($config_file); isa_ok($api, 'Flickr::API::Reflection'); is($api->is_oauth, 1, 'Does this Flickr::API::Reflection object identify as OAuth'); is($api->api_success, 1, 'Did reflection api initialize successful'); my $methods = $api->methods_list(); SKIP: { skip "Skipping methods_list tests, not able to reach the API or received error", 3, if !$api->api_success; like($methods->[0], qr/^flickr\.[a-z]+\.[a-zA-Z]+$/, "Does the list appear to have a method"); my %check = map {$_ => 1} @{$methods}; is( $check{'flickr.reflection.getMethods'}, 1, 'Was flickr.reflection.getMethods in the methods_list'); is( $check{'flickr.reflection.getMethodInfo'}, 1, 'Was flickr.reflection.getMethodInfo in the methods_list'); } my $hashmethods = $api->methods_hash(); SKIP: { skip "Skipping methods_hash tests, not able to reach the API or received error", 2, if !$api->api_success; is( $hashmethods->{'flickr.reflection.getMethods'}, 1, 'Was flickr.reflection.getMethods in the methods_hash'); is( $hashmethods->{'flickr.reflection.getMethodInfo'}, 1, 'Was flickr.reflection.getMethodInfo in the methods_hash'); } my $meth = $api->get_method('flickr.replection.getMethodInfo'); is( $api->api_success, 0, 'Did we fail on a fake method as expected'); $meth = $api->get_method('flickr.people.getLimits'); is( $api->api_success, 1, 'Was flickr.people.getLimits successful as expected'); $meth = $api->get_method('flickr.reflection.getMethodInfo'); is( $api->api_success, 1, 'Were we successful as expected'); is( $meth->{'flickr.reflection.getMethodInfo'}->{argument}->{api_key}->{optional}, 0, 'Did get method reflect that api_key argument is not optional'); } exit; __END__ # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/10-upload.t0000644000175000017500000000473514567143531015070 0ustar ubuntuubuntuuse strict; use warnings; use Test::More; use Flickr::API; use Flickr::API::Upload; if (defined($ENV{MAKETEST_OAUTH_CFG})) { plan( tests => 8 ); } else { plan(skip_all => 'Upload tests require that MAKETEST_OAUTH_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_OAUTH_CFG}; my $config_ref; my $test_image = "t/10-upload.jpg"; my $api; my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is( $fileflag, 1, "Is the config file: $config_file, readable?" ); SKIP: { skip "Skipping upload tests, oauth config isn't there or is not readable", 7 ############## if $fileflag == 0; $api = Flickr::API->import_storable_config($config_file); isa_ok($api, 'Flickr::API'); is( $api->is_oauth, 1, 'Does this Flickr::API object identify as OAuth' ); is( $api->api_success, 1, 'Did api initialize successful' ); my $apiperms = $api->api_permissions(); my $imageflag=0; my $permsflag=0; if ($apiperms eq 'write' or $apiperms eq 'delete') { $permsflag=1; } is( $permsflag, 1, "Do we have write or delete permissions" ); SKIP: { skip "Skipping some upload tests, not enough permission to upload with the API", 3 ########## if $permsflag == 0; if (-r $test_image) { $imageflag = 1; } is( $imageflag, 1, "Is the test image: $test_image, readable?" ); SKIP: { skip "Skipping some upload tests, test image file isn't there or is not readable", 2 ########## if $imageflag == 0; my $sendargs = { 'photo' => $test_image, 'tags' => 'Perl,"Flickr::API"', 'async' => 0, 'title' => 'Perl Flickr::API test', 'description' => 'Small test image for testing Flickr::API upload', }; my $response = $api->upload($sendargs); my $apihash = $response->as_hash; is( $api->api_success, 1, 'Did upload record API success' ); my $photoid = $apihash->{photoid}; isnt( $photoid, undef, 'Did we get a photoid' ); } # image file } # perms } # oauth config exit; __END__ # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/06-flickr-authenticated-methods.t0000644000175000017500000000462414567143531021341 0ustar ubuntuubuntuuse strict; use warnings; use Test::More; use Storable; use Flickr::API; if (defined($ENV{MAKETEST_FLICKR_CFG})) { plan( tests => 15 ); } else { plan(skip_all => 'These tests require that MAKETEST_FLICKR_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_FLICKR_CFG}; my $config_ref; my $api; my $proceed = 0; my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, readable?"); SKIP: { skip "Skipping authentication tests, flickr config isn't there or is not readable", 15 if $fileflag == 0; $api = Flickr::API->import_storable_config($config_file); isa_ok($api, 'Flickr::API'); is($api->is_oauth, 0, 'Does Flickr::API object identify as Flickr'); like($api->{fauth}->{api_key}, qr/[0-9a-f]+/i, "Did we get an api key from $config_file"); like($api->{fauth}->{api_secret}, qr/[0-9a-f]+/i, "Did we get an api secret from $config_file"); if (defined($api->{fauth}->{token}) and $api->{fauth}->{token} =~ m/^[0-9]+-[0-9a-f]+$/i) { $proceed = 1; } SKIP: { skip "Skipping authentication tests, flickr access token missing or seems wrong", 10 if $proceed == 0; my $rsp = $api->execute_method('flickr.auth.checkToken', {auth_token => $api->{fauth}->{token}}); is($rsp->success(), 1, "Did flickr.auth.checkToken complete sucessfully"); my $ref = $rsp->as_hash(); is($ref->{stat}, 'ok', "Did flickr.auth.checkToken complete sucessfully"); isnt($ref->{auth}->{user}->{nsid}, undef, "Did flickr.auth.checkToken return nsid"); isnt($ref->{auth}->{user}->{username}, undef, "Did flickr.auth.checkToken return username"); $rsp = $api->execute_method('flickr.test.login', {auth_token => $api->{fauth}->{token}}); $ref = $rsp->as_hash(); is($ref->{stat}, 'ok', "Did flickr.test.login complete sucessfully"); isnt($ref->{user}->{id}, undef, "Did flickr.test.login return id"); isnt($ref->{user}->{username}, undef, "Did flickr.test.login return username"); $rsp = $api->execute_method('flickr.prefs.getPrivacy', {auth_token => $api->{fauth}->{token}}); $ref = $rsp->as_hash(); is($ref->{stat}, 'ok', "Did flickr.prefs.getPrivacy complete sucessfully"); isnt($ref->{person}->{nsid}, undef, "Did flickr.prefs.getPrivacy return nsid"); isnt($ref->{person}->{privacy}, undef, "Did flickr.prefs.getPrivacy return privacy"); } } exit; __END__ # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/04-flickr_authuri.t0000644000175000017500000000176314567143531016620 0ustar ubuntuubuntuuse strict; use warnings; use Test::More; use Data::Dumper; use Storable; use Flickr::API; if (defined($ENV{MAKETEST_FLICKR_CFG})) { plan( tests => 5 ); } else { plan(skip_all => 'These tests require that MAKETEST_FLICKR_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_FLICKR_CFG}; my $config_ref; my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, readable?"); SKIP: { skip "Skipping request_auth_url tests, flickr config isn't there or is not readable", 4 if $fileflag == 0; my $api = Flickr::API->import_storable_config($config_file); isa_ok($api, 'Flickr::API'); is($api->is_oauth, 0, 'Does Flickr::API object identify as Flickr'); like($api->{api_key}, qr/[0-9a-f]+/i, "Did we get a hexadecimal api key in the config"); like($api->{api_secret}, qr/[0-9a-f]+/i, "Did we get a hexadecimal api secret in the config"); } #skip request_auth_url tests # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/03-oauth_consumer.t0000644000175000017500000000325214567143531016632 0ustar ubuntuubuntuuse strict; use warnings; use Test::More; use Storable; use Flickr::API; if (defined($ENV{MAKETEST_OAUTH_CFG})) { plan( tests => 7 ); } else { plan(skip_all => 'These tests require that MAKETEST_OAUTH_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_OAUTH_CFG}; my $config_ref; my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is($fileflag, 1, "Is the config file: $config_file, readable?"); SKIP: { skip "Skipping consumer message tests, oauth config isn't there or is not readable", 6 if $fileflag == 0; my $rsp; my $ref; my $api = Flickr::API->import_storable_config($config_file); isa_ok($api, 'Flickr::API'); is($api->is_oauth, 1, 'Does Flickr::API object identify as OAuth'); $rsp = $api->execute_method('flickr.test.echo', {format => 'fake'}); SKIP: { skip "skipping error code check, since we couldn't reach the API", 1 if $rsp->rc() ne '200'; is($rsp->error_code(), 111, 'checking the error code for "format not found"'); } $rsp = $api->execute_method('flickr.reflection.getMethods'); $ref = $rsp->as_hash(); SKIP: { skip "skipping method call check, since we couldn't reach the API", 1 if $rsp->rc() ne '200'; is($ref->{'stat'}, 'ok', 'Check for ok status from flickr.reflection.getMethods'); } $rsp = $api->execute_method('flickr.test.echo', { 'foo' => 'barred' } ); $ref = $rsp->as_hash(); SKIP: { skip "skipping method call check, since we couldn't reach the API", 2 if $rsp->rc() ne '200'; is($ref->{'stat'}, 'ok', 'Check for ok status from flickr.test.echo'); is($ref->{'foo'}, 'barred', 'Check result from flickr.test.echo'); } } exit; # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/10-upload.jpg0000644000175000017500000001752614567143531015407 0ustar ubuntuubuntuJFIFHH ExifMM*>F(iNxHH02100100(/HHJFIFC    $.' ",#(7),01444'9=82<.342C  2!!22222222222222222222222222222222222222222222222222-Z" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?N~#ؽėUKI%` qy>AQ(%k$+=+0e7 |ͻseҮ5ȵ/ _&{$k"]ʒ4[bI!r z;T q4^bnB[OC`i"c̳۷)\,8 ~qV}F!QÞ}5f{*b]@PI99@QP-\U@HBڴrȷ0# OEWࠆ YH 3V(#To%,=>X)`):' ƿRu'lk!!Зo+zS:4}R]Zk"UFh+WWV7 ,%yPbc.es1mOZBJГ,^\ xqry*|,q=lpdr: NFwW)FKoዝ*\۱K#g|~oແY]}Vm$#0 Rsq]Z6G֋MkjC2/ CvZ~*!c8X]A@~EEr6{usj.lfd@HÏ*k𾱥 I .r<Ҙp2Fc$zUxs]ծm|$w%yCjCXU# a~4%йI<םGBoμngO 5 f9, E ŻcFlickr::API testingVhttp://ns.adobe.com/xap/1.0/ 72 72 Inch Internal error (unknown value 0) 72 72 Inch Exif Version 2.1 FlashPix Version 1.0 Internal error (unknown value 65535) C     C   Z!  ާA-9wid^k%JŜ G[@"7Ę-\@s;Q{JBO&d P,#eXW%(ثZs#Hr]$iv:gn)vro2+)NeTͭoD5@*P! DF_7 ՌuKhK6puQ[h@ 1!"2AQa#@q3R$0Ss 5Bbrtu?%2pXŎZ̿9r0$ѷ$nMw@:Tmݿ Mm{sr(1zTI2b匵/ bfZuѭv጑&LʺSApLC`˷LJ{#4쩏KDܢ6b&B$ú|>(iJy(xc )9u({9RrJkib%JA37u6J{n N6\{ R@^A῞ %Լ_n&Δz^T0ʐ(P/J /vs :B$ujF} {K %5T]Cya$tɯ˞#Xo鐂i_t=xj} S3hOnmG>]Nͱ')ڵm]"pvǣ )#drҎOJiQXmvÌGub;+3q)b HԮ)ϲI HBWr.P_WxZf3mhRP 5%4m Ir-V؜5.W +lz7YU:b<猙xlӞy:FY'HW1^W$'5Gd7Z"O9&y AGS K5=l![X<$F"}+CluEnZ/Qܞ(ňba5î1߁̹ TP>_^XI\]vM6MxHF-^Q\ 6mE(UhUOqJ|>͟#qk·W&!1AQaq@0 ?! +4~);? v#?ӫd_ӓf:l0ZoAk&M@e?Cv߭TxTPβi/#>+-Fj3AFFo> (xl& MZ6, ݶ^ôf6wy˯_S߼CX7{qXސە"gɉ+ͩ|ZŁJp[r6($[X -ͺc``ύL߽2]jXw\Wg>  zoG?oˌ ~ޞ[́/xYrJmrrm<<5/CF\QNUPSW]8(݃0q(O#Gb|9(`ls&Be<9e)[hBl-||N{E6 M { @|Ʌ\/x@n2k:zJGz  ,nWc@(t}!hJƉf||\sTYPns$JF&; qHmYo=7ARS+ LL̈L̄@H ̀@L@L ̍!0!1aA`?= gPx{4tf<i;]U@9Z\ȳLRdyυu?'!1AQa@ 0q?q7AIUt:l@IJtg 6ǓJ1yfׇ}Fb QPz 'q8!CAh6W@>YBt1i(2JKΈS0J"/bKX %ANZmNLYÔ)s^DJrf$Vdu]wrQᖡaߚ"h)* bhJTR*U*-C^Br=rJm = Zi_1rR[,s(() /mFS-BKySnYa39IyHPT,/X U`;[9SnYa3oXn:@ pM "@h2AQGa*CҰfI2uHYZc㒨ԥ 8yޜE{چ-Bꟻ"vԗW\Ox;Av&<\AU27$9!g#)aeiÞw'BD)$fH I S!K]Y5I.3"vԗI`/Xv(f@ WQ,<*5t'=`}6,W%.|$Z+V}ftuˍT7,kC[;&7y{CO¨ :W5C <3ХB'ZcQ:GhZrUW-I 4ӣ4d\P M# bvoN ASe7XH zr|x d $t( -=P…Ĩ5a[rVo"G/=@A3veG.#6knh۪osJ5]K 16 ); } else { plan(skip_all => 'People tests require that MAKETEST_OAUTH_CFG points to a valid config, see README.'); } my $config_file = $ENV{MAKETEST_OAUTH_CFG}; my $config_ref; my $api; my $fileflag=0; if (-r $config_file) { $fileflag = 1; } is( $fileflag, 1, "Is the config file: $config_file, readable?" ); SKIP: { skip "Skipping people tests, oauth config isn't there or is not readable", 7 ############## if $fileflag == 0; $api = Flickr::API::People->import_storable_config($config_file); isa_ok($api, 'Flickr::API::People'); is( $api->is_oauth, 1, 'Does this Flickr::API::People object identify as OAuth' ); is( $api->api_success, 1, 'Did people api initialize successful' ); my $valsflag=0; my $values_file; if (defined($ENV{MAKETEST_VALUES})) { $values_file = $ENV{MAKETEST_VALUES}; if (-r $values_file) { $valsflag = 1; } } SKIP: { skip "Skipping some people tests, values file isn't there or is not readable", 12 ########## if $valsflag == 0; is( $valsflag, 1, "Is the values file: $values_file, readable?" ); my %peoplevalues = ( 'search_email' => '', 'search_username' => '', ); open my $VALUES, "<", $values_file or die; while (<$VALUES>) { chomp; s/\s+//g; my ($key,$val) = split(/=/); if (defined($peoplevalues{$key})) { $peoplevalues{$key} = $val; } } isnt( $peoplevalues{'search_email'}, '', 'Is there an email to search for' ); isnt( $peoplevalues{'search_user'}, '', 'Is there a userid to search for' ); isnt( $api->findByEmail($peoplevalues{'search_email'}), '', 'did we get a username from an email' ); is( $api->findByEmail('a-non-existent-email-address@nowhere.noway.nohow.nom'), undef, 'did we fail to get username on bogus email address' ); isnt( $api->findByUsername($peoplevalues{'search_username'}), '', 'did we get a username from a username search' ); is( $api->findByUsername('a-non-existent-user-name-nom-nom.noway.nohow.nom'), undef, 'did we fail to get username on bogus username search' ); is( $api->findByUsername($peoplevalues{'search_username'}), $peoplevalues{'search_username'}, 'did we get the correct username from a username search' ); is( $api->username, $peoplevalues{'search_username'}, 'did we get the correct username from the api object' ); isnt( $api->nsid, '', 'did we get and nsid from the username search' ); is( ref($api->user), 'HASH', 'did we get a user hash from the username search' ); is( $api->findByUsername('a-non-existent-user-name-nom-nom.noway.nohow.nom'), undef, 'did we fail to get username on bogus username search' ); } # vals File } # oauth config exit; __END__ # Local Variables: # mode: Perl # End: Flickr-API-1.29/t/01-test.t0000644000175000017500000000663614567143531014565 0ustar ubuntuubuntuuse strict; use warnings; use Test::More tests => 26; use Flickr::API; ################################################## # # create an api object # my $api = Flickr::API->new({ 'key' => 'made_up_key', 'secret' => 'my_secret', }); isa_ok $api, 'Flickr::API'; my $rsp = $api->execute_method('fake.method', {}); isa_ok $rsp, 'Flickr::API::Response'; ################################################## # # check we get the 'method not found' error # SKIP: { skip "skipping error code check, since we couldn't reach the API", 1 if $rsp->rc() ne '200'; # this error code may change in future! is($rsp->error_code(), 212, 'checking the error code for "method not found"'); } ################################################## # # check the 'format not found' error is working # $rsp = $api->execute_method('flickr.test.echo', {format => 'fake'}); SKIP: { skip "skipping error code check, since we couldn't reach the API", 4 if $rsp->rc() ne '200'; is($rsp->error_code(), 111, 'checking the error code for "format not found"'); my $status = {}; $rsp->_propagate_status($status); is($status->{_rc}, $rsp->rc(), 'checking that http response code propagated'); is($status->{success}, $rsp->success(), 'checking that success flag propagated'); is($status->{error_code}, $rsp->error_code(), 'checking that error code propagated'); } ################################################## # # check the signing works properly # is($api->_sign_args({'foo' => 'bar'}), '466cd24ced0b23df66809a4d2dad75f8', "Signing test 1"); is($api->_sign_args({'foo' => undef}), 'f320caea573c1b74897a289f6919628c', "Signing test 2"); $api->{unicode} = 0; is('b8bac3b2a4f919d04821e43adf59288c', $api->_sign_args({'foo' => "\xE5\x8C\x95\xE4\xB8\x83"}), "Signing test 3 (unicode=0)"); $api->{unicode} = 1; is('b8bac3b2a4f919d04821e43adf59288c', $api->_sign_args({'foo' => "\x{5315}\x{4e03}"}), "Signing test 4 (unicode=1)"); ################################################## # # check the auth url generator is working # my $perm = $api->request_auth_url('enlighten', 'my_frob'); is($perm, undef, "Did request_auth_url object to invalid permission"); my $uri = $api->request_auth_url('read', 'my_frob'); my %hash; $perm = $api->request_auth_url('write', 'my_frob'); %hash=parse_query($perm->query); is($hash{perms}, 'write', "did request_auth_url accept write permissions"); $perm = $api->request_auth_url('delete', 'my_frob'); %hash=parse_query($perm->query); is($hash{perms}, 'delete', "did request_auth_url accept delete permissions"); my %expect = parse_query('api_sig=75522c3db27dfa3e79023a1b58c844a8&perms=read&frob=my_frob&api_key=made_up_key'); my %got = parse_query($uri->query); sub parse_query { return split /[&=]/, shift; } 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"); } is($uri->path, '/services/auth/', "Checking correct return path"); is($uri->host, 'api.flickr.com', "Checking return domain"); is($uri->scheme, 'https', "Checking return protocol"); ################################################## # # check we can't generate a url without a secret # $api = Flickr::API->new({'key' => 'key'}); $uri = $api->request_auth_url('read', 'frob'); is($uri, undef, "Checking URL generation without a secret"); Flickr-API-1.29/Makefile.PL0000644000175000017500000000663414567143531014710 0ustar ubuntuubuntuuse ExtUtils::MakeMaker; warn < 'Flickr::API', 'VERSION_FROM' => 'lib/Flickr/API.pm', 'LICENSE' => 'perl', 'MIN_PERL_VERSION' => '5.008', 'META_MERGE' => { resources => { repository => 'https://github.com/iamcal/perl-Flickr-API', }, }, 'PREREQ_PM' => { 'LWP::UserAgent' => 0, 'HTTP::Request' => 0, 'HTTP::Request::Common' => 0, 'HTTP::Response' => 0, 'HTTP::Message' => 1.56, # first version of libwww that supports decoded_content() 'URI' => 1.18, 'XML::Parser::Lite::Tree' => 0.06, 'XML::LibXML::Simple' => 0, 'Digest::MD5' => 0, 'Getopt::Long' => 1, 'parent' => 0, 'Test::More' => 0, 'Test::Script' => 0, 'Net::OAuth' => 0, }, 'TEST_REQUIRES' => { 'Test::Script' => 0, }, 'EXE_FILES' => [ 'script/flickr_dump_stored_config.pl', 'script/flickr_make_stored_config.pl', 'script/flickr_make_test_values.pl', ] ); Flickr-API-1.29/Changes0000644000175000017500000001334314567143531014224 0ustar ubuntuubuntuChanges to Flickr::API 1.28, 2016-10-11 * Add Flickr::API::Upload * Flickr::API Be more consistent using my ($self, $args,...) = @_; and not shift * Flickr::API Change from using $options to $args for consistancy * Flickr::API Add upload method * Flickr::API add api_type method * Flickr::API add api_permissions method * Flickr::API stop using "return undef;" * Flickr::API begin *_silently_* enforcing api_key/api_secret over key/secret * Flickr::API::Response Be more consistent using my ($self, $args,...) = @_; and not shift * Added MAKETEST_OAUTH_AUTHED=1 and/or MAKETEST_FLICKR_AUTHED=1 for testing to allow testing actual calls without re-authenticating * Added more info on testing to README * changes to tests for authentication to allow bypassing * changes to tests for authentication to allow permissions other than read * changes to tests to detect if deprecated key/secret become api_key/api_secret * changed script/flickr_dump_stored_config.pl to allow config file to be passed in ARGV * changed script/flickr_make_stored_config.pl to shift configs from key/secret to api_key/api_secret for Flickr Authentication and warn if key/secret are used. 1.27, 2015-12-02 * Get Flickr::API::People into shape for the Tools. * Added some methods for asking about a people object's calling user and searched user. 1.26, 2015-11-17 * Removed references to oauth_token and oauth_token_secret since they are redundant. * Get some spelling consistent * Tidy up a test script 1.25, 2015-10-12 * Realizing that there is benefit to keeping Flickr::API as close to perl core as practical and letting Flickr::Tools use Moo and more abstraction, stopped moving all of Flickr::Tools into Flickr::API. * Moved Person.pm and Types.pm to Flickr::Tools. * Bumped version by five to keep it ahead of Tools, at least for the time being. 1.20, 2015-10-05 * moved Cameras.pm, Reflection.pm and People.pm to new status reporting. * Added Person.pm for the flickr.people methods other than finds * Added tests for Person.pm * Updated the MANIFEST * Add tests to 02-oauth_api.t for new script and for private method * Added Types.pm to define types for Moo types * Consider splitting the Tools back into a separate distribution so Moo isn't required for the base API. 1.19, 2015-09-16 * adding Flickr::API::People for the flickr.people methods that find * adding t/09-people.t to test People module * fixed Reflection.pm for argument lists that are only 1 deep. * added test to 07-reflection for method that does not have argument array, but rather just a single argument * moved flickr deprecated authentication from $api->{flickr} to $api->{fauth} to make better use of $api->{flickr} for subclassing. * added a number of status reporting methods to API.pm * add _propagate_status to Response.pm * add script/flickr_make_test_values.pl for more in-depth testing 1.18, 2015-08-12 * adding Flickr::API::Cameras * adding t/08-cameras.t to test Cameras module * replaced the STUB on Reflection.pm POD with the intended text * Merge in Pull Request from rjbs 1.17, 2015-08-04 * adding Flickr::API::Reflection * adding t/07-reflection.t to test Reflection module * Fixed typo per RT-106107 * moved from @ISA to use parent in Request.pm and Response.pm * added call to and method _initialize to API.pm to support inheritance in Reflection.pm et. al. * make import_storable_config more generic in API.pm * make error_message a little prettier in Response.pm * invert changes for chronological convenience 1.16, 2015-07-17 * merged in horsepunchkid's $perms fixes. (API requires more explicit perms arguments) * merged in horsepunchkid's fixes in examples/. * fleshed out the $perms fixes, changed from warn to carp. * Added to API.pm POD to reflect $perms fixes. * Added tests to reflect $perms fixes. * bumped version in prep for PAUSE upload. 1.15 * Removed some debugging leftovers * bumped version 1.14 * Added 5.008 as minimum Perl version * Moving from XML::Simple to XML::LibXML::Simple * Remove example from automatically installing in scripts (Request 105426) * move dump and make config scripts to bin and made them install-worthy (Request 105426) * Clarified licenses in examples (Request 105426) * Rename oauth_export_config to export_config and add ability to export Flickr's native, if deprecated, configuration. Similar renames and reasons for export_storable_config and import_storable_config. * Added a hashref of the response content in addition to a tree * Added a number of accessor methods to Response.pm * Made code a little more "Perl Best Practices"-ish * Rename sign_args to _sign_args 1.12, 1.13, 2015-06-09 * Cleaned up minor bugs found by testers, improved kwalitee * Clarified licensing 1.11, 2014-12-27 * Added OAuth authentication to Flickr::API and Flickr::API::Request * Added some examples 1.08, 2013-06-19 * Various cleanup from Gabor Szabo 1.07, 2013-05-23 * Added flag to enable handling of native Unicode strings 1.06, 2013-05-11 * Added `lwpobj` argument, to allow using subclasses of LWP::UserAgent 1.05, 2012-09-12 * Updated Flickr API urls from http://www.flickr.com/services/ to http://api.flickr.com/services/. 1.04, 2009-08-25 * re-fix for perl5.6 - just require a newer version of HTTP::Message which supports mime-decoding instead. 1.03, 2009-08-23 * fix for perl5.6 - when HTTP::Message->decoded_content() comes back empty, use content() instead. 1.02, 2009-07-31 * license update for fedora 1.01, 2008-09-30 * incorrectly numbered the previous release. gah * updated tests to work when the flickr api isn't hit-able 0.10, 2008-09-29 * Work correctly with latest XML::Parser::Lite::Tree (now requires 0.06) * Added patch from Flavio Poletti to allow custom api & auth urls Flickr-API-1.29/script/0000755000175000017500000000000014567144144014232 5ustar ubuntuubuntuFlickr-API-1.29/script/flickr_make_test_values.pl0000755000175000017500000001101414567143531021453 0ustar ubuntuubuntu#!/usr/bin/env perl #------------------------------- # flickr_make_test_values.pl #_______________________________ use warnings; use strict; use Term::ReadLine; use Pod::Usage; use Getopt::Long; my $values = {}; my $cli_args = {}; my %defaults = ( 'search_email' => '', 'search_username' => '', ); my %prompts = ( 'search_email' => 'An email to search for', 'search_username' => 'A user id to search for', ); my $invalues = \%defaults; GetOptions ( $cli_args, 'values_in=s', 'values_out=s', 'help', 'man', 'usage' ); #------------------------------------------------------------- # Respond to help-type arguments or if missing required params #_____________________________________________________________ if ($cli_args->{'help'} or $cli_args->{'usage'} or $cli_args->{'man'} or !$cli_args->{'values_out'}) { pod2usage({ -verbose => 2 }); } #------------------------------------------------------------------ # If an incoming values is specified and exists, read it if we can. # if any of the keys are defined (that is, a value we will use) # overwrite the default. #__________________________________________________________________ if (defined($cli_args->{'values_in'}) and -e $cli_args->{'values_in'}) { my $key; my $value; open my $VALUES_IN, '<', $cli_args->{'values_in'} or die "\nCannot open $cli_args->{'values_in'} for read: $!\n"; while (<$VALUES_IN>) { s/\s+//g; ($key,$value) = split(/=/); if (defined($invalues->{$key})) { $invalues->{$key}=$value; } } close($VALUES_IN) or die "\nClose error $!\n"; } #--------------------------------- # Create a term incase we need it. #_________________________________ my $term = Term::ReadLine->new('Flickr Value Collector'); $term->ornaments(0); my $which_rl = $term->ReadLine; if ($which_rl eq "Term::ReadLine::Perl" or $which_rl eq "Term::ReadLine::Perl5") { warn "\n\nTerm::ReadLine::Perl and Term::ReadLine::Perl5 may display prompts" . "\nincorrectly. If this is the case for you, try adding \"PERL_RL=Stub\"" . "\nto the environment variables passed in with make test\n\n"; } #-------------------------------------------------------------------- # build or confirm values #____________________________________________________________________ foreach my $key (sort keys %defaults) { my $value = $term->readline( $prompts{$key} ." [ ". $invalues->{$key}."]: "); if (!$value) { $values->{$key} = $invalues->{$key}; } else { $values->{$key} = $value; } } #------------------------------- # Display values and store same. #_______________________________ open my $VALUES_OUT, '>', $cli_args->{'values_out'} or die "\nCannot open $cli_args->{'values_out'} for write: $!\n"; foreach my $key (sort keys %defaults) { print $key," = ",$values->{$key},"\n"; print $VALUES_OUT $key," = ",$values->{$key},"\n"; } close($VALUES_OUT) or die "\nClose error $!\n"; exit; __END__ =pod =head1 NAME flickr_make_test_values.pl - script to assist with testing the Flickr::API =head1 SYNOPSIS C =head1 OPTIONS =head2 Required: B< > =over 5 =item B<--values_out> points to where to create the stored Flickr values file =back =head2 Optional: B< > =over 5 =item B<--values_in> points to the optional input values file to use as a base for the I<--values_out> file you are creating. B< > =item B<--help> as expected =item B<--usage> =item B<--man> =back =head1 DESCRIPTION This script is a lightweight method to assemble key/value pairs for testing the Flickr::API. It is used to build a file for the B portion of installation. It does not I and sticks to modules from perl core so that it can be used prior to-- and perhaps in conjunction with-- installation and testing of the Flickr::API module. When you B, add the environment variable MAKETEST_VALUES, pointing to the key/values file you specified. The command should look something like: make test MAKETEST_VALUES=/home/myusername/test-flickr-values.txt or make test MAKETEST_VALUES=/home/myusername/test-flickr-values.txt \ MAKETEST_OAUTH_CFG=/home/myusername/test-flickr-oauth.st =head1 LICENSE AND COPYRIGHT Copyright (c) 2015, Louis B. Moore C<< >>. This program is released under the Artistic License 2.0 by The Perl Foundation. =head1 SEE ALSO The README in the Flickr::API distribution. Flickr-API-1.29/script/flickr_make_stored_config.pl0000755000175000017500000002470114567143531021751 0ustar ubuntuubuntu#!/usr/bin/env perl #------------------------------- # flickr_make_stored_config.pl #_______________________________ use warnings; use strict; use Data::Dumper; use Term::ReadLine; use Storable qw( retrieve_fd store_fd ); use Pod::Usage; use Getopt::Long; my $config = {}; my $inconfig = {}; my $cli_args = {}; my $heads_up = 0; GetOptions ( $cli_args, 'config_in=s', 'config_out=s', 'api_type=s', 'frob=s', 'api_key=s', 'api_secret=s', 'key=s', 'secret=s', 'token=s', 'consumer_key=s', 'consumer_secret=s', 'callback=s', 'token=s', 'token_secret=s', 'help', 'man', 'usage' ); #------------------------------------------------------------- # Respond to help-type arguments or if missing required params #_____________________________________________________________ if ($cli_args->{'help'} or $cli_args->{'usage'} or $cli_args->{'man'} or !$cli_args->{'config_out'}) { pod2usage({ -verbose => 2 }); } #------------------------------------------------------------------ # If an incoming config is specified and exists, read it if we can. #__________________________________________________________________ if (defined($cli_args->{'config_in'}) and -e $cli_args->{'config_in'}) { open my $CONFIG_IN, '<', $cli_args->{'config_in'} or die "\nCannot open $cli_args->{'config_in'} for read: $!\n"; $inconfig = retrieve_fd($CONFIG_IN); close($CONFIG_IN) or die "\nClose error $!\n"; } #--------------------------------- # Create a term incase we need it. #_________________________________ my $term = Term::ReadLine->new('Flickr Configurer'); $term->ornaments(0); my $which_rl = $term->ReadLine; if ($which_rl eq "Term::ReadLine::Perl" or $which_rl eq "Term::ReadLine::Perl5") { warn "\n\nTerm::ReadLine::Perl and Term::ReadLine::Perl5 may display prompts" . "\nincorrectly. If this is the case for you, try adding \"PERL_RL=Stub\"" . "\nto the environment variables passed in with make test\n\n"; } #------------------ # Flickr or OAuth ? #__________________ if (defined($cli_args->{'api_type'}) and $cli_args->{'api_type'} =~ m/^f.*/i ) { $cli_args->{'api_type'} = 'flickr'; } else { $cli_args->{'api_type'} = 'oauth'; } #-------------------------------------------------------------------- # build config in layers. 1st undef, then config_in and finally args. # Prompt if missing key/secret # save key and secret as api_key and api_secret, moving api away from # un-specified key type #____________________________________________________________________ if ( $cli_args->{'api_type'} eq 'flickr' ) { $config->{'api_key'} = undef; $config->{'api_secret'} = undef; $config->{'frob'} = undef; $config->{'callback'} = undef; $config->{'token'} = undef; if (defined($inconfig->{'key'})) { $config->{'api_key'} = $inconfig->{'key'}; $heads_up++; } if (defined($inconfig->{'secret'})) { $config->{'api_secret'} = $inconfig->{'secret'}; $heads_up++; } if (defined($inconfig->{'api_key'})) { $config->{'api_key'} = $inconfig->{'api_key'}; } if (defined($inconfig->{'api_secret'})) { $config->{'api_secret'} = $inconfig->{'api_secret'}; } if (defined($inconfig->{'frob'})) { $config->{'frob'} = $inconfig->{'frob'}; } if (defined($inconfig->{'callback'})) { $config->{'callback'} = $inconfig->{'callback'}; } if (defined($inconfig->{'token'})) { $config->{'token'} = $inconfig->{'token'}; } if (defined($cli_args->{'key'})) { $config->{'api_key'} = $cli_args->{'key'}; $heads_up++;} if (defined($cli_args->{'secret'})) { $config->{'api_secret'} = $cli_args->{'secret'}; $heads_up++;} if (defined($cli_args->{'api_key'})) { $config->{'api_key'} = $cli_args->{'api_key'}; } if (defined($cli_args->{'api_secret'})) { $config->{'api_secret'} = $cli_args->{'api_secret'}; } if (defined($cli_args->{'frob'})) { $config->{'frob'} = $cli_args->{'frob'}; } if (defined($cli_args->{'callback'})) { $config->{'callback'} = $cli_args->{'callback'}; } if (defined($cli_args->{'token'})) { $config->{'token'} = $cli_args->{'token'}; } if ($heads_up > 0) { warn "\n\nNote: key and secret are changing to api_key and api_secret as part of the\nmove to OAuth to help make it more evident that the Flickr authentication is being used.\n\n"; } unless (defined($config->{'api_key'})) { $config->{'api_key'} = get_key($cli_args->{'api_type'}); } unless (defined($config->{'api_secret'})) { $config->{'api_secret'} = get_secret($cli_args->{'api_type'}); } } else { $config->{'consumer_key'} = undef; $config->{'consumer_secret'} = undef; $config->{'callback'} = undef; $config->{'token_secret'} = undef; $config->{'token'} = undef; if (defined($inconfig->{'consumer_key'})) { $config->{'consumer_key'} = $inconfig->{'consumer_key'}; } if (defined($inconfig->{'consumer_secret'})) { $config->{'consumer_secret'} = $inconfig->{'consumer_secret'}; } if (defined($inconfig->{'callback'})) { $config->{'callback'} = $inconfig->{'callback'}; } if (defined($inconfig->{'token_secret'})) { $config->{'token_secret'} = $inconfig->{'token_secret'}; } if (defined($inconfig->{'token'})) { $config->{'token'} = $inconfig->{'token'}; } if (defined($cli_args->{'consumer_key'})) { $config->{'consumer_key'} = $cli_args->{'consumer_key'}; } if (defined($cli_args->{'consumer_secret'})) { $config->{'consumer_secret'} = $cli_args->{'consumer_secret'}; } if (defined($cli_args->{'callback'})) { $config->{'callback'} = $cli_args->{'callback'}; } if (defined($cli_args->{'token_secret'})) { $config->{'token_secret'} = $cli_args->{'token_secret'}; } if (defined($cli_args->{'token'})) { $config->{'token'} = $cli_args->{'token'}; } unless (defined($config->{'consumer_key'})) { $config->{'consumer_key'} = get_key($cli_args->{'api_type'}); } unless (defined($config->{'consumer_secret'})) { $config->{'consumer_secret'} = get_secret($cli_args->{'api_type'}); } } #------------------------------- # Display config and store same. #_______________________________ print "\n\nSaving\n\n",Dumper($config),"\nin ",$cli_args->{'config_out'}," using Storable\n\n"; open my $CONFIG_OUT, '>', $cli_args->{'config_out'} or die "\nCannot open $cli_args->{'config_out'} for write: $!\n"; store_fd $config, $CONFIG_OUT; close($CONFIG_OUT) or die "\nClose error $!\n"; exit; #-------------- # Subroutiones #______________ sub get_key { my $authtype = shift; my $loop = 0; my $getkey; while ($loop == 0) { my $keyprompt = 'OAuth consumer key for Flickr'; if ($authtype eq 'flickr') { $keyprompt = 'Flickr api key'; } print "\n"; $getkey = $term->readline("Enter your " . $keyprompt .": "); if ($getkey =~ m/^[0-9a-f]+$/i) { print "\n$keyprompt: ",$getkey," accepted\n"; $loop++ } else { print "\n$keyprompt ",$getkey,"is not a hex number\n"; } } return $getkey; } sub get_secret { my $authtype = shift; my $loop = 0; my $getsecret; while ($loop == 0) { my $secretprompt = 'OAuth consumer secret for Flickr'; if ($authtype eq 'flickr') { $secretprompt = 'Flickr api secret'; } print "\n"; $getsecret = $term->readline("Enter your " . $secretprompt .": "); if ($getsecret =~ m/^[0-9a-f]+$/i) { print "\n$secretprompt: ",$getsecret," accepted\n"; $loop++ } else { print "\n$secretprompt ",$getsecret,"is not a hex number\n"; } } return $getsecret; } __END__ =pod =head1 NAME flickr_make_stored_config.pl - script to assist with testing and using the Flickr::API =head1 SYNOPSIS C =head1 OPTIONS =head2 Required: B< > =over 5 =item B<--config_out> points to where to create the stored Flickr config file =back =head2 Optional: B< > =over 5 =item B<--config_in> points to the optional input config file to use as a base for the I<--config_out> file you are creating. B< > =item B<--api_type> either I for the original, but deprecated, Flickr authentication OR I for the OAuth authentication. it defaults to I B< > I =item B<--api_key> The api key when used with Flickr authentication I B<--key> still works to maintain compatibility with L 1.10 and before, but it is saved as api_key. B< > =item B<--secret> The api secret when used with Flickr authentication I B<--secret> still works to maintain compatibility with L 1.10 and before, but it is saved as api_secret. B< > =item B<--frob> The frob used in Flickr authentication B< > =item B<--token> The auth token can be either a Flickr or OAuth Access token used with Flickr authentication B< > I =item B<--consumer_key> The api key when used with OAuth authentication I B< > =item B<--consumer_secret> The api secret when used with OAuth authentication I B< > =item B<--callback> The callback uri for use in OAuth authentication B< > =item B<--token_secret> The OAuth access token secret B< > B< > =item B<--help> as expected =item B<--usage> =item B<--man> =back =head1 DESCRIPTION This script is a lightweight method to assemble the required arguments for using the Flickr::API. It can be used to assemble the configuration(s) needed for the B portion of installation. It does not I and sticks to modules from perl core so that it can be used prior to-- and perhaps in conjunction with-- installation and testing of the Flickr::API module. When you B, add the environment variable MAKETEST_OAUTH_CFG, MAKETEST_FLICKR_CFG or both; each pointing to the configuration file you specified. The command should look something like: make test MAKETEST_OAUTH_CFG=/home/myusername/test-flickr-oauth.cfg or make test MAKETEST_FLICKR_CFG=/home/myusername/test-flickrs-auth.cfg or make test MAKETEST_FLICKR_CFG=/home/myusername/test-flickrs-auth.cfg \ MAKETEST_OAUTH_CFG=/home/myusername/test-flickr-oauth.cfg =head1 LICENSE AND COPYRIGHT Copyright (c) 2015-2016, Louis B. Moore C<< >>. This program is released under the Artistic License 2.0 by The Perl Foundation. =head1 SEE ALSO The README in the Flickr::API distribution. Flickr-API-1.29/script/flickr_dump_stored_config.pl0000755000175000017500000000403714567143531022001 0ustar ubuntuubuntu#!/usr/bin/env perl #----------------------------- # flickr_dump_stored_config.pl #_____________________________ use warnings; use strict; use Data::Dumper; use Storable qw(store_fd retrieve_fd); use Getopt::Long; use Pod::Usage; my $config; my $cli_args = {}; GetOptions ( $cli_args, 'config_in=s', 'help', 'man', 'usage' ); if (defined($ARGV[0])) { $cli_args->{'config_in'} = $ARGV[0]; } #------------------------------------------------------------- # Respond to help-type arguments or if missing required params #_____________________________________________________________ if ($cli_args->{'help'} or $cli_args->{'usage'} or $cli_args->{'man'} or !$cli_args->{'config_in'}) { pod2usage({ -verbose => 2 }); } open my $CFG, "<", $cli_args->{'config_in'} or die "Failed to open $cli_args->{'config_in'}: $!"; $config = retrieve_fd($CFG); close $CFG; $Data::Dumper::Sortkeys=1; print "\n\n\n\nRetrieved\n\n",Dumper($config),"\nfrom ",$cli_args->{'config_in'}," using Storable\n\n"; exit; __END__ =pod =head1 NAME flickr_dump_stored_config.pl - script to display contents of a Flickr::API storable configuration file. =head1 SYNOPSIS C =head1 OPTIONS =head2 Required: B< > =over 5 =item Either a B or =item B<--config_in> pointing to the stored Flickr config file. B< > =back =over 5 =item B<--help> as expected =item B<--usage> =item B<--man> =back =head1 DESCRIPTION This script is a lightweight way to dump the contents of a Flickr::API storable configuration. It does not I and sticks to modules from perl core so that it can be used prior to-- and perhaps in conjunction with-- installation and testing of the Flickr::API module. =head1 LICENSE AND COPYRIGHT Copyright (c) 2015-2016, Louis B. Moore C<< >>. This program is released under the Artistic License 2.0 by The Perl Foundation. =head1 SEE ALSO The README in the Flickr::API distribution. Flickr-API-1.29/META.yml0000664000175000017500000000157314567144144014207 0ustar ubuntuubuntu--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: '0' Test::Script: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Flickr-API no_index: directory: - t - inc requires: Digest::MD5: '0' Getopt::Long: '1' HTTP::Message: '1.56' HTTP::Request: '0' HTTP::Request::Common: '0' HTTP::Response: '0' LWP::UserAgent: '0' Net::OAuth: '0' Test::More: '0' Test::Script: '0' URI: '1.18' XML::LibXML::Simple: '0' XML::Parser::Lite::Tree: '0.06' parent: '0' perl: '5.008' resources: repository: https://github.com/iamcal/perl-Flickr-API version: '1.29' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Flickr-API-1.29/examples/0000755000175000017500000000000014567144144014544 5ustar ubuntuubuntuFlickr-API-1.29/examples/flickr_oauth_authentication.pl0000644000175000017500000001356014567143531022656 0ustar ubuntuubuntu#!/usr/bin/perl # # Example for using Flickr OAuth Authentication # use warnings; use strict; use Flickr::API; use Data::Dumper; use Getopt::Long; use Term::ReadKey; use Term::ReadLine; use Pod::Usage; =pod =head1 DESCRIPTION The original Flickr Authentication has been deprecated in favor of OAuth. This example script shows one way to use L to go from having just the consumer_key and consumer_secret (or api_key and api_secret using Flickr's terminology) to an authenticated token. =head1 USAGE ./flickr_oauth_authentication.pl \ --consumer_key="24680beef13579feed987654321ddcc6" \ --consumer_secret="de0cafe4feed0242" \ [ --perms={read,write,delete} \] [ --config_out="/path/to/a/writable/config.st" ] [ --help ] [ --man ] If not specified, perms defaults to read. The script will produce a url for you to enter into a browser then prompt you to enter the callback url that is returned by flickr. It then does a Data::Dumper dump of the parameter keys and values which can be recorded for future use. If you want to make it more complete, you could modify the script to format and dump the information into a config file of some type. =head1 PROGRAM FLOW Following the flow laid out in L =cut my $term = Term::ReadLine->new('Flickr OAuth authentication'); $term->ornaments(0); my $which_rl = $term->ReadLine; if ($which_rl eq "Term::ReadLine::Perl" or $which_rl eq "Term::ReadLine::Perl5") { warn "\n\nTerm::ReadLine::Perl and Term::ReadLine::Perl5 may display prompts" . "\nincorrectly. If this is the case for you, try adding \"PERL_RL=Stub\"" . "\nto the environment variables passed in with make test\n\n"; } $Data::Dumper::Sortkeys = 1; my $cli_args = {}; GetOptions ( $cli_args, 'consumer_key=s', 'consumer_secret=s', 'perms=s', 'config_out=s', 'help|?|usage', 'man' ); pod2usage(1) if ($cli_args->{help}); pod2usage(-verbose => 2) if ($cli_args->{man}); # # get $cli_args prepared to pass into API # my $permstr = $cli_args->{'perms'}; delete $cli_args->{'perms'}; my $configfile = $cli_args->{'config_out'}; delete $cli_args->{'config_out'}; =head2 Flickr Step 1, Application: get a request token The script takes the consumer_key and consumer secret and creates a Flickr::API object. It then calls the B method with an optional I specified. my $api = Flickr::API->new($cli_args); $api->oauth_request_token({'callback' => 'https://127.0.0.1'}); =cut my $api = Flickr::API->new($cli_args); $api->oauth_request_token({'callback' => 'https://127.0.0.1'}); =head2 Flickr Step 1, Flickr: return a request token. The oauth request token is saved in the Flickr::API object. =head2 Flickr Step 2. Application: Direct user to Flickr for Authorization The script now calls the B method with the optional I parameter. The Flickr::API returns a uri which (in this case) is cut in the terminal and pasted into a browser. my $request2 = $api->oauth_authorize_uri({'perms' => $cli_args->{'perms'}}); print "\n\nYou now need to open: \n\n$request2\n\nin a browser.\n "; =cut my $permreq = 'read'; if ( $permstr && $permstr =~ /^(read|write|delete)$/) { $permreq = $permstr; } my $request2 = $api->oauth_authorize_uri({'perms' => $permreq}); print "\n\nYou now need to open: \n\n$request2\n\nin a browser.\n "; =head2 Flickr Step 2. Flickr: Prompts user to provide Authorization Assuming all is well with the I and I Flickr will open a webpage to allow you to authenticate the application identified by the B to have the requested B. =head2 Flickr Step 2. User: User authorizes application access This is you, granting permission to the application. =head2 Flick Step 2, Flickr: redirects the user back to the application Flickr returns an B in the callback. In this script you cut the callback from the browser and paste it into the terminal to continue on to the next step. $response2 = $term->readline('Enter the callback redirected url: '); The cutting and pasting is a little crude, but you only have to do it once. =cut my $response2 = $term->readline('Press [Enter] after setting up authorization on Flickr. '); print "\n\n"; ReadMode(1); $response2 = $term->readline('Enter the callback redirected url: '); # # Redirects user back to Application, passing oauth_verifier # (entry done by hand, snort.) # chomp ($response2); print "\n\n"; my ($url2,$parm2) = split(/\?/,$response2); my (@parms) = split(/\&/,$parm2); my %hash2; foreach my $param2 (@parms) { my ($key,$val) = split(/=/,$param2); $key =~ s/oauth_//; $hash2{$key}=$val; } =head2 Flickr Step 3, Application: exchange request token for access token The script takes the B and the B and exchanges them for an B. my $request3 = $api->oauth_access_token(\%hash2); =cut my $request3 = $api->oauth_access_token(\%hash2); =head2 Flickr Step 3, Flickr: returns an access token and token secret Flickr will return an B and B if all has gone well. These are stashed in the Flickr::API object. =head2 Save the access information How you save the access information is outside the scope of this example. However, the B method can be used to retrieve the oauth parameters from the Flickr::API object. my %oconfig = $api->export_config('protected resource'); print Dumper(\%oconfig); =cut my %oconfig = $api->export_config('protected resource'); print Dumper(\%oconfig); if ($configfile) { $api->export_storable_config($configfile); } exit; __END__ =pod =head1 AUTHOR Louis B. Moore =head1 COPYRIGHT AND LICENSE Copyright 2014,2016, Louis B. Moore This program is released under the Artistic License 2.0 by The Perl Foundation. =cut Flickr-API-1.29/examples/flickr_flickr_authentication.pl0000644000175000017500000001307114567143531023005 0ustar ubuntuubuntu#!/usr/bin/perl # # Example for using Flickr's Deprecated Authentication # use warnings; use strict; use Flickr::API; use Data::Dumper; use Getopt::Long; use Term::ReadKey; use Term::ReadLine; use Pod::Usage; =pod =head1 DESCRIPTION The original Flickr Authentication has been deprecated in favor of OAuth. The example flickr_oauth_authentication.pl should be used in favor of this one. However, this script uses the deprecated-- but seemingly still alive-- Flickr authentication to go from having just the api_key and api_secret to an authenticated token. =head1 USAGE ./flickr_flickr_authentication.pl \ --api_key="24680beef13579feed987654321ddcc6" \ --api_secret="de0cafe4feed0242" \ [ --perms={read,write,delete} \] [ --config_out="/path/to/a/writable/config.st" ] [ --help ] [ --man ] If not specified, perms defaults to read. --key and --api_key are synonymous and --secret and --api_secret are also synonymous. The script will produce a url for you to enter into a browser then prompt you to press [ENTER] once you have authenticated on Flickr. It then does a Data::Dumper dump of the parameter keys and values which can be recorded for future use. If you want to make it more complete, you could modify the script to format and dump the information into a config file of some type. Alternatively, you can use the --config_out to specify a filename that the API can use to save itself into using the storable format. =head1 PROGRAM FLOW Following the flow laid out in L more or less. =cut =head2 Flickr Steps 1&2, Obtain and configure an api_key Out of scope for this particular script. We are assuming you have already obtained and configured youe api_key. =cut my $term = Term::ReadLine->new('Flickr deprecated authentication'); $term->ornaments(0); my $which_rl = $term->ReadLine; if ($which_rl eq "Term::ReadLine::Perl" or $which_rl eq "Term::ReadLine::Perl5") { warn "\n\nTerm::ReadLine::Perl and Term::ReadLine::Perl5 may display prompts" . "\nincorrectly. If this is the case for you, try adding \"PERL_RL=Stub\"" . "\nto the environment variables passed in with make test\n\n"; } $Data::Dumper::Sortkeys = 1; my $cli_args = {}; GetOptions ( $cli_args, 'api_key=s', 'api_secret=s', 'key=s', 'secret=s', 'perms=s', 'config_out=s', 'help|?|usage', 'man' ); pod2usage(1) if ($cli_args->{help}); pod2usage(-verbose => 2) if ($cli_args->{man}); # # get $cli_args prepared to pass into API # my $permstr = $cli_args->{'perms'}; delete $cli_args->{'perms'}; my $configfile = $cli_args->{'config_out'}; delete $cli_args->{'config_out'}; $cli_args->{'api_key'} = $cli_args->{'api_key'} || $cli_args->{'key'}; delete $cli_args->{'key'}; $cli_args->{'api_secret'} = $cli_args->{'api_secret'} || $cli_args->{'secret'}; delete $cli_args->{'secret'}; =head2 Flickr Step 3, Application: get a frob The script takes the api_key and api_secret and creates a Flickr::API object. It then calls the B method. my $api = Flickr::API->new($cli_args); my $rsp = $api->execute_method("flickr.auth.getFrob"); =cut my $api = Flickr::API->new($cli_args); my $rsp = $api->execute_method("flickr.auth.getFrob"); unless ($rsp->success()) { die "\ngetFrob failed with ",$rsp->error_code,": ",$rsp->error_message,"\n"; } my $answer = $rsp->as_hash(); my $frob = $answer->{frob}; =head2 Flickr Step 4. Application: Direct user to Flickr for Authorization The script now calls the B method with the optional I parameter. The Flickr::API returns a uri which (in this case) is cut from the terminal and pasted into a browser. my $request4 = $api->request_auth_uri($perms, $frob); print "\n\nYou now need to open: \n\n$request4\n\nin a browser.\n "; =cut my $permreq = 'read'; if ( $permstr && $permstr =~ /^(read|write|delete)$/) { $permreq = $permstr; } my $uri = $api->request_auth_url($permreq,$frob); my $request4 = $uri->as_string; print "\n\nYou now need to open: \n\n$request4\n\nin a browser.\n "; =head2 Flickr Step 4. Flickr: Prompts user to provide Authorization Assuming all is well with the I and I Flickr will open a webpage to allow you to authenticate the application identified by the B to have the requested B. =head2 Flickr Step 4. User: User authorizes application access This is you, granting permission to the application. =cut print "\n\n"; ReadMode(1); my $response4 = $term->readline('Press [Enter] after setting up authorization on Flickr. '); =head2 Flickr Step 5, Application: exchange frob for token The script takes the B and exchanges it for a B. my $request5 = $api->flickr_access_token($frob); =cut my $request5 = $api->flickr_access_token($frob); =head2 Flickr Step 5, Flickr: returns a token Flickr will return a B if all has gone well. This is stashed in the Flickr::API object. =head2 Save the access information How you save the access information is outside the scope of this example. However, the B method can be used to retrieve the flickr parameters from the Flickr::API object. my %fconfig = $api->export_config(); print Dumper(\%fconfig); =cut my %fconfig = $api->export_config(); print Dumper(\%fconfig); if ($configfile) { $api->export_storable_config($configfile); } exit; __END__ =pod =head1 AUTHOR Louis B. Moore =head1 COPYRIGHT AND LICENSE Copyright 2016, Louis B. Moore This program is released under the Artistic License 2.0 by The Perl Foundation. =cut Flickr-API-1.29/examples/flickr_method_test_echo.pl0000644000175000017500000000436214567143531021754 0ustar ubuntuubuntu#!/usr/bin/perl # # Method Test Echo # =pod =head1 NAME flickr_method_test_echo.pl an example for using either OAuth or Old School Flickr =cut use warnings; use strict; use Flickr::API; use Getopt::Long; =pod =head1 DESCRIPTION This script uses either the Flickr or OAuth parameters to call the flickr.test.echo method. =head1 USAGE flickr_method_test_echo.pl --use_api=[oauth, flickr] \ --key="24680beef13579feed987654321ddcc6" \ --secret="de0cafe4feed0242" Depending on what you specify with B<--use_api> the flickr.test.echo call will use the appropriate parameter set. If Bnew> is called with a consumer_key, OAuth is used. If Bnew> with key the old Flickr Authentication is used. =cut my $config = {}; my $api; GetOptions ( $config, 'use_api=s', 'key=s', 'secret=s', ); =head1 CALL DIFFERENCES if ($config->{use_api} =~ m/flickr/i) { $api = Flickr::API->new({'key' => $config->{key}, 'secret' => $config->{secret}}); } elsif ($config->{use_api} =~ m/oauth/i) { $api = Flickr::API->new({'consumer_key' => $config->{key}, 'consumer_secret' => $config->{secret}}); } else { die "\n --use_api must be either 'flickr' or 'oauth' \n"; } =cut if ($config->{use_api} =~ m/flickr/i) { $api = Flickr::API->new({ 'key' => $config->{key}, 'secret' => $config->{secret}, }); } elsif ($config->{use_api} =~ m/oauth/i) { $api = Flickr::API->new({ 'consumer_key' => $config->{key}, 'consumer_secret' => $config->{secret}, }); } else { die "\n --use_api must be either 'flickr' or 'oauth' \n"; } my $response = $api->execute_method('flickr.test.echo', { 'foo' => 'bar', 'baz' => 'quux', }); my $ref = $response->as_hash(); print "\n\n",$ref->{method},"\n"; print " Key: foo received: ",$ref->{foo},"\n"; print " Key: baz received: ",$ref->{baz},"\n\n\n"; exit; __END__ =pod =head1 AUTHOR Louis B. Moore Based on the code in Flickr::API. =head1 COPYRIGHT AND LICENSE Copyright 2014, Louis B. Moore This program is released under the Artistic License 2.0 by The Perl Foundation. =cut Flickr-API-1.29/examples/flickr_method_test_login.pl0000644000175000017500000000575514567143531022155 0ustar ubuntuubuntu#!/usr/bin/perl # # Method Test Login # =pod =head1 NAME flickr_method_test_echo.pl a login example for using either OAuth or Old School Flickr =cut use warnings; use strict; use Flickr::API; use Getopt::Long; =pod =head1 DESCRIPTION This script uses either the Flickr or OAuth parameters to call the flickr.test.login method. =head1 USAGE flickr_method_test_login.pl --use_api=[oauth, flickr] \ --key="24680beef13579feed987654321ddcc6" \ --secret="de0cafe4feed0242" \ --token="72157beefcafe3582-1ad0feedface0e60" \ [--token_secret="33beef1face212d"] Depending on what you specify with B<--use_api> the flickr.test.login call will use the appropriate parameter set. The B<--token_secret> is used by OAuth, but not by the original Flickr. =cut my $config = {}; my $api; my %args; GetOptions( $config, 'use_api=s', 'key=s', 'secret=s', 'token=s', 'token_secret=s', ); =head1 CALL DIFFERENCES if ($config->{use_api} =~ m/flickr/i) { $api = Flickr::API->new({ 'key' => $config->{key}, 'secret' => $config->{secret}, 'auth_token' => $config->{token}, }); $args{'api_key'} = $config->{key}; $args{'auth_token'} = $config->{token}; } elsif ($config->{use_api} =~ m/oauth/i) { $api = Flickr::API->new({ 'consumer_key' => $config->{key}, 'consumer_secret' => $config->{secret}, 'token' => $config->{token}, 'token_secret' => $config->{token_secret}, }); $args{'consumer_key'} = $config->{key}; $args{'token'} = $config->{token}; } else { die "\n --use_api must be either 'flickr' or 'oauth' \n"; } =cut if ($config->{use_api} && $config->{use_api} eq 'flickr') { $api = Flickr::API->new({ 'key' => $config->{key}, 'secret' => $config->{secret}, 'auth_token' => $config->{token}, }); $args{'api_key'} = $config->{key}; $args{'auth_token'} = $config->{token}; } elsif ($config->{use_api} && $config->{use_api} eq 'oauth') { $api = Flickr::API->new({ 'consumer_key' => $config->{key}, 'consumer_secret' => $config->{secret}, 'token' => $config->{token}, 'token_secret' => $config->{token_secret}, }); $args{'consumer_key'} = $config->{key}; $args{'token'} = $config->{token}; } else { die "\n --use_api must be either 'flickr' or 'oauth'\n"; } my $response = $api->execute_method('flickr.test.login', \%args); my $ref = $response->as_hash(); if ($api->is_oauth) { print "\nOAuth formated login status: ",$ref->{stat},"\n"; } else { print "\nFlickr formated login status: ",$ref->{stat},"\n"; } exit; __END__ =pod =head1 AUTHOR Louis B. Moore Based on the code in Flickr::API. =head1 LICENSE AND COPYRIGHT Copyright 2014, Louis B. Moore This program is released under the Artistic License 2.0 by The Perl Foundation. =cut Flickr-API-1.29/README0000644000175000017500000001151714567143531013612 0ustar ubuntuubuntuFlickr::API =========== An interface to the Flickr API, including OAuth authentication. INSTALLATION To install this module type the following: perl Makefile.PL make make test [ MAKETEST_OAUTH_CFG=config_file, MAKETEST_FLICKR_CFG=other_config, MAKETEST_VALUES=values_file, MAKETEST_PERMS={read, write, or delete}, [MAKETEST_OAUTH_AUTHED=1, MAKETEST_FLICKR_AUTHED=1]] make install NOTES ON API CHANGES If you use key and secret when instantiating a new API object, be aware that the Flickr::API silently changes these to api_key and api_secret for use and configuration export. Since Flickr is (ambivalently) deprecating their own authentication in favor of OAuth, in time key and secret will become confusing, is key api_key? or consumer_key? For now, key and secret are silently changed. In future releases there will be a warning when they are used. NOTES ON TESTING Testing the Flickr::API can be a bit of a puzzle. You may wish to test features that require authentication to upload images. You may not want to expose your key and permissions to a test written by someone you don't know. To try and allow you to dial in the level of testing you want to use, there are several environmental variables to work with. To interact with Flickr during testing, use either MAKETEST_OAUTH_CFG or MAKETEST_FLICKR_CFG or both. MAKETEST_OAUTH_AUTHED=1, MAKETEST_FLICKR_AUTHED=1 and MAKETEST_PERMS can be used to change aspects of the interactions with Flickr. Testing authenticated method calls requires a previously authenticated consumer key and secret (or api key and secret for Flickr's authentication) saved in a configuration with the data in Storable.pm format that the tests can read. Tests will need either 'read' or 'write' permissions. The tests do not use delete permission to delete. The tests default to 'read'. If you want to test uploads, you will need a configuration with 'write' or 'delete' permission. The variable MAKETEST_PERMS can be used to pass in requested permissions other than 'read'. If you are testing a previously authenticated configuration, specifying MAKETEST_OAUTH_AUTHED=1 or MAKETEST_FLICKR_AUTHED=1 will bypass the authentication tests. In addition, testing authentication requires, at minimum, your Flickr consumer_key and consumer_secret; a file with some minimal configuration data in Storable.pm format that the tests can read and write; the ability to open a url on Flickr; and the ability to retrieve a redirectfrom Flickr. Since there is some user interaction required, full authentication testing has to be done manually with something like: make test MAKETEST_OAUTH_CFG=$HOME/oauth-testing.st [MAKETEST_PERMS=write] [TEST_VERBOSE=1] or make test MAKETEST_FLICKR_CFG=$HOME/flickr-auth-testing.st [TEST_VERBOSE=1] or even make test MAKETEST_OAUTH_CFG=$HOME/oauth-testing.st \ MAKETEST_FLICKR_CFG=$HOME/flickr-auth-testing.st [TEST_VERBOSE=1] There are two scripts in the script directory that can be used to build and verify a Storable.pm format configuration file: script/flickr_make_stored_config.pl and script/flickr_dump_stored_config.pl When using OAuth, the api_key and api_secret are called the consumer_key and consumer_secret respectively. When using the deprecated Flickr authentication, the api_key and api_secret are sometimes called key and secret. It is possible to use authentication testing to produce a configuration in storable format that can be imported into the Flickr::API for future use. MORE ON AUTHENTICATION When using the original Flickr authentication, there are two methods: web-based and non-web-based. For web-based the developer defines a callback URL, which is where the Flickr will redirect the session, along with a frob. For non-webbased, you need to make a call to flickr.auth.getFrob to obtain the frob to exchange for a token. The tests only deal with web-based authentication. In general, since Flickr deprecated their original authentication in favor of OAuth, more effort is dedicated to OAuth. If you are using Flickr's authentication, and you receive an "Oops! Flickr can't find a valid callback URL." page, then you are calling an API that is not web-based. DEPENDENCIES This module requires these other modules and libraries: Carp Data::Dumper Digest::MD5 Encode Getopt::Long HTTP::Request HTTP::Request::Common HTTP::Response LWP::UserAgent Net::OAuth parent Scalar::Util Storable Term::ReadLine URI XML::Parser::Lite::Tree XML::LibXML::Simple Testing this module and using the examples additionally require: File::Temp Test::More Test::Script COPYRIGHT AND LICENSE Copyright (C) 2004-2013 Cal Henderson License: Perl Artistic License 2.0 OAuth patches and additions Copyright (C) 2014-2016 Louis B. Moore License: Perl Artistic License 2.0 Flickr-API-1.29/META.json0000664000175000017500000000306514567144144014355 0ustar ubuntuubuntu{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Flickr-API", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Digest::MD5" : "0", "Getopt::Long" : "1", "HTTP::Message" : "1.56", "HTTP::Request" : "0", "HTTP::Request::Common" : "0", "HTTP::Response" : "0", "LWP::UserAgent" : "0", "Net::OAuth" : "0", "Test::More" : "0", "Test::Script" : "0", "URI" : "1.18", "XML::LibXML::Simple" : "0", "XML::Parser::Lite::Tree" : "0.06", "parent" : "0", "perl" : "5.008" } }, "test" : { "requires" : { "Test::Script" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/iamcal/perl-Flickr-API" } }, "version" : "1.29", "x_serialization_backend" : "JSON::PP version 4.02" } Flickr-API-1.29/MANIFEST0000644000175000017500000000160114567144132014052 0ustar ubuntuubuntuscript/flickr_dump_stored_config.pl script/flickr_make_stored_config.pl script/flickr_make_test_values.pl Changes examples/flickr_method_test_echo.pl examples/flickr_method_test_login.pl examples/flickr_oauth_authentication.pl examples/flickr_flickr_authentication.pl lib/Flickr/API.pm lib/Flickr/API/Cameras.pm lib/Flickr/API/People.pm lib/Flickr/API/Request.pm lib/Flickr/API/Response.pm lib/Flickr/API/Reflection.pm lib/Flickr/API/Upload.pm LICENSE Makefile.PL MANIFEST META.json META.yml Module meta-data (added by MakeMaker) README README.subclasses t/01-test.t t/02-oauth_api.t t/02-flickr_api.t t/03-flickr_api.t t/03-oauth_consumer.t t/04-flickr_authuri.t t/04-oauth_requesttoken.t t/05-flickr_authentication.t t/05-oauth_authentication.t t/06-flickr-authenticated-methods.t t/06-oauth-authenticated-methods.t t/07-reflection.t t/08-cameras.t t/09-people.t t/10-upload.t t/10-upload.jpg Flickr-API-1.29/lib/0000755000175000017500000000000014567144144013474 5ustar ubuntuubuntuFlickr-API-1.29/lib/Flickr/0000755000175000017500000000000014567144144014706 5ustar ubuntuubuntuFlickr-API-1.29/lib/Flickr/API.pm0000644000175000017500000010454014567143732015663 0ustar ubuntuubuntupackage 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.29'; 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__ =head1 NAME Flickr::API - Perl interface to the Flickr API =head1 SYNOPSIS =head2 Using OAuth to call a B not requiring authentication use Flickr::API; my $api = Flickr::API->new({ 'consumer_key' => 'your_api_key', 'consumer_secret' => 'your_app_secret', }); my $response = $api->execute_method('flickr.test.echo', { 'foo' => 'bar', 'baz' => 'quux', }); my $config_file = $HOME/saved-flickr.st; $api->export_storable_config($config_file); =head2 Non-OAuth method calling B not requiring authentication use Flickr::API; # key deprecated in favor of api_key # secret deprecated in favor of api_secret # my $api = Flickr::API->new({ 'api_key' => 'your_api_key', 'api_secret' => 'your_app_secret', }); my $response = $api->execute_method('flickr.test.echo', { 'foo' => 'bar', 'baz' => 'quux', }); =head2 Alternatively, Using OAuth for non-authenticated B use Flickr::API; use Flickr::API::Request; my $api = Flickr::API->new({'consumer_key' => 'your_api_key','consumer_secret' => 'your_app_secret'}); my $request = Flickr::API::Request->new({ 'method' => 'flickr.test.echo', 'args' => {}, }); my $response = $api->execute_request($request); =head2 Authenticate an OAuth API Object starting with saved configuration use Flickr::API; use Term::ReadLine; my $config_file = "$ENV{HOME}/saved-flickr.st"; my $term = Term::ReadLine->new('Testing Flickr::API'); $term->ornaments(0); my $api = Flickr::API->import_storable_config($config_file); my $rt_rc = $api->oauth_request_token( { 'callback' => 'https://127.0.0.1/' } ); my %request_token; if ( $rt_rc eq 'ok' ) { my $uri = $api->oauth_authorize_uri({ 'perms' => 'read' }); my $prompt = "\n\n$uri\n\n" . "Copy the above url to a browser, and authenticate with Flickr\n" . "Press [ENTER] once you get the redirect: "; my $input = $term->readline($prompt); $prompt = "\n\nCopy the redirect URL from your browser and enter it\nHere: "; $input = $term->readline($prompt); chomp($input); my ($callback_returned,$token_received) = split(/\?/,$input); my (@parms) = split(/\&/,$token_received); foreach my $pair (@parms) { my ($key,$val) = split(/=/,$pair); $key =~ s/oauth_//; $request_token{$key}=$val; } } my $ac_rc = $api->oauth_access_token(\%request_token); if ( $ac_rc eq 'ok' ) { $api->export_storable_config($config_file); my $response = $api->execute_method('flickr.auth.oauth.checkToken'); my $hash_ref = $response->as_hash(); $response = $api->execute_method('flickr.prefs.getPrivacy'); my $rsp_node = $response->as_tree(); } =head2 The OAuth authorization uri will look something like: https://api.flickr.com/services/oauth/authorize?oauth_token=12345678901234567-890abcdefedcba98&perms=read =head2 The callback is called with a token and verifier such as: https://127.0.0.1/?oauth_token=12345678901234567-890abcdefedcba98&oauth_verifier=cafe12345678feed =head1 DESCRIPTION An interface for using the Flickr API. C is a subclass of L, so all of the various proxy, request limits, caching, etc are available. C can instantiate using either the Flickr Authentication (deprecated) or the OAuth Authentication. OAuth is handled using L. =head1 SUBROUTINES/METHODS =over =item C 'value', ... })> Returns as new L object. The options are as follows: =over =item either C for the Flickr auth or C for OAuth Your API key (one or the other form is required) =item either C for the Flickr auth or C for OAuth Your API key's secret (the one matching the api_key/consumer_key is required) =item C & C Override the URIs used for contacting the API. =item C Base the C on this object, instead of creating a new instance of L. This is useful for using the features of e.g. L. =item C This flag controls whether Flickr::API expects you to pass UTF-8 bytes (unicode=0, the default) or actual unicode strings (unicode=1) in the request. =item C, C, C, C, C These values are used by L to assemble and sign OAuth I request Flickr API calls. The defaults are usually fine. =item C The callback is used in oauth authentication. When Flickr authorizes you, it returns the access token and access token secret in a callback URL. This defaults to https://127.0.0.1/ =item C and C These values are used by L to assemble and sign OAuth I request Flickr API calls. =back =item C Constructs a L object and executes it, returning a L object. =item C Executes a L object, returning a L object. Calls are signed if a secret was specified when creating the L object. =item C Returns a L object representing the URL that an application must redirect a user to for approving an authentication token. C<$perms> must be B, B, or B. For web-based applications I<$frob> is an optional parameter. Returns undef if a secret was not specified when creating the C object. =item C Returns a hash of all or part of the persistent parts of the Flickr::API object with additional behaviors for Flickr::API objects using OAuth. =over =item oauth message type: one of C, C, C, C or C This is one of the the message type that L handles. Message type is optional. =item oauth parameter set: C or C or undef. L will return message params, api params or all params depending on what is requested. All params is the default. =back If the Flickr::API object identifies as Flickr original authentication, return a hashref $VAR1 = { 'frob' => '12332112332112300-feedabcde123456c-1234567', 'api_key' => 'cafefeedbeef13579246801234567890', 'api_secret' => 'beef321432154321', 'token' => '97531086421234567-cafe123456789abc' }; or the subset thereof depending on what has been used by the API. If the older form of key/secret was used, the constructor will change these to the api_key/api_secret forms. If the API object identifies as OAuth authentication, and C is specified, then export_config will return a hash of the OAuth parameters for the specified L message type. Further, if parameter is specified, then export_config returns either either the set of B parameters or B parameters for the message type. If parameter is not specified then both parameter type are returned. For example: my %config = $api->export_config('protected resource'); or my %config = $api->export_config('protected resource','message'); When export_config is called without arguments, then it returns the OAuth portion of the L object. If present the L I and I objects are also included. VAR1 = { 'access_token' => bless( { 'extra_params' => { 'fullname' => 'Louis', 'user_nsid' => '12345678@N00', 'username' => 'meanameicallmyself' }, 'from_hash' => 1, 'token' => '12345678901234567-cafe123098765432', 'token_secret' => 'eebeef000fedbca1' }, 'Net::OAuth::AccessTokenResponse' ), 'callback' => 'https://127.0.0.1', 'consumer_key' => 'cafefeedbeef13579246801234567890', 'consumer_secret' => 'fedcba9876543210', 'nonce' => '917fa882fa7babd5a1b7702e7d19502a', 'request_method' => 'GET', 'request_url' => 'https://api.flickr.com/services/rest/', 'signature_method' => 'HMAC-SHA1', 'timestamp' => 1436129308, 'token' => '12345678901234567-cafe123098765432', 'token_secret' => 'eebeef000fedbca1', 'version' => '1.0' }; my %config = $api->export_config(); =back This method can be used to extract and save the API parameters for future use. =over =item C This method wraps export_config with a file open and storable store_fd to add some persistence to a Flickr::API object. =item C This method retrieves a storable config of a Flickr::API object and revivifies the object. =item C Returns the oauth request type in the Flickr::API object. Some Flickr methods will require a C request type and others a simple C request type. =item C Assembles, signs, and makes the OAuth B call, and if sucessful stores the L I in the L object. The required parameters are: =over =item C Your API Key =item C Your API Key's secret =item C The URI Method: GET or POST =item C Defaults to: L =back =item C The required parameters are: =over =item C =back =item C Assembles, signs, and makes the OAuth B call, and if sucessful stores the L I in the L object. The required parameters are: =over =item C Your API Key =item C Your API Key's secret =item C The URI Method: GET or POST =item C Defaults to: L =item C The request token secret from the L I object returned from the I call. =back =item C Returns a L object representing the URL that an application must redirect a user to for approving a request token. =over =item C Permission the application is requesting, one of B, defaults to B. =back =item C Returns B<1> if the L object is OAuth flavored, B<0> otherwise. =back =head1 AUTHOR Cal Henderson, Ecal@iamcal.comE Auth API patches provided by Aaron Straup Cope Subclassing patch from AHP OAuth patches and additions Louis B. Moore =head1 LICENSE AND COPYRIGHT Copyright (C) 2004-2013, Cal Henderson, Ecal@iamcal.comE OAuth patches and additions Copyright (C) 2014-2016 Louis B. Moore This program is released under the Artistic License 2.0 by The Perl Foundation. =head1 SEE ALSO L, L, L, L, L, L L L =cut Flickr-API-1.29/lib/Flickr/API/0000755000175000017500000000000014567144144015317 5ustar ubuntuubuntuFlickr-API-1.29/lib/Flickr/API/Response.pm0000644000175000017500000000732214567143531017456 0ustar ubuntuubuntupackage Flickr::API::Response; use strict; use warnings; use HTTP::Response; use parent qw(HTTP::Response); our $VERSION = '1.28'; sub new { my $class = shift; my $self = HTTP::Response->new; my $options = shift; bless $self, $class; return $self; } sub init_flickr { my ($self, $options) = @_; $self->{tree} = undef; $self->{hash} = undef; $self->{success} = 0; $self->{error_code} = 0; $self->{error_message} = ''; return; } sub set_fail { my ($self, $code, $message) = @_; $self->{success} = 0; $self->{error_code} = $code; $self->{error_message} = $message; return; } sub set_ok { my ($self, $tree, $hashref) = @_; $self->{success} = 1; $self->{tree} = $tree; $self->{hash} = $hashref; return; } # # some accessors # sub as_tree { my ($self) = @_; if (defined $self->{tree}) { return $self->{tree}; } else { return; } } sub as_hash { my ($self) = @_; if (defined $self->{hash}) { return $self->{hash}; } else { return; } } sub error_code { my ($self) = @_; return $self->{error_code}; } sub error_message { my ($self) = @_; my $text = $self->{error_message}; $text =~ s/\"/\"/g; return $text; } sub success { my ($self) = @_; return $self->{success}; } sub rc { my ($self) = @_; return $self->{_rc}; } sub _propagate_status { my $self = shift; my $stat = shift; $stat->{_rc} = $self->{_rc}; # http response _rc $stat->{success} = $self->{success}; # set by Flickr::API::Response $stat->{error_code} = $self->{error_code}; # Returned by Flickr or set in API $stat->{error_message} = $self->error_message(); # use method since it fixes text return; } 1; __END__ =head1 NAME Flickr::API::Response - A response from the flickr API. =head1 SYNOPSIS use Flickr::API; use Flickr::API::Response; my $api = Flickr::API->new({'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 L with the following additional keys: { 'success' => 1, 'tree' => XML::Parser::Lite::Tree, 'hash' => Flickr response as a hash, 'error_code' => 0, 'error_message' => '', } The C<_request> key contains the request object that this response was generated from. This request will be a L object, which is a subclass of L. The C key contains 1 or 0, indicating whether the request succeeded. If it failed, C and C explain what went wrong. If it succeeded, C contains an L object of the response XML. =head1 METHODS =over =item C Returns the args passed to flickr with the method that produced this response =item C Returns the args passed to flickr with the method that produced this response =item C Returns the Flickr Error Code, if any =item C Returns the Flickr Error Message, if any =item C Returns the success or lack thereof from Flickr =item C Returns the Flickr http status code =item C<_propagate_status(\%hash)> Returns the entire response status block as a hashref. =back =head1 AUTHOR Copyright (C) 2004, Cal Henderson, Ecal@iamcal.comE Copyright (C) 2015-2016, Louis B. Moore, Elbmoore@cpan.orgE OAuth and accessor methods. =head1 SEE ALSO L, L =cut Flickr-API-1.29/lib/Flickr/API/Reflection.pm0000644000175000017500000001004114567143531017742 0ustar ubuntuubuntupackage Flickr::API::Reflection; use strict; use warnings; use Carp; use parent qw( Flickr::API ); our $VERSION = '1.28'; sub _initialize { my $self = shift; $self->_set_status(1,'API::Reflection initialized'); return; } sub methods_list { my $self = shift; my $rsp = $self->execute_method('flickr.reflection.getMethods'); $rsp->_propagate_status($self->{flickr}->{status}); my $listref = (); if ($rsp->success() == 1) { $listref = $rsp->as_hash()->{methods}->{method}; $self->_set_status(1,"flickr.reflection.getMethods returned " . $#{$listref} . " methods.") } else { $self->_set_status(0,"Flickr::API::Reflection Methods list/hash failed with response error"); carp "Flickr::API::Reflection Methods list/hash failed with error code: ",$rsp->error_code()," \n ", $rsp->error_message(),"\n"; my $listref = (); } return $listref; } sub methods_hash { my $self = shift; my $arrayref = $self->methods_list(); my $hashref; if ($arrayref) { %{$hashref} = map {$_ => 1} @{$arrayref}; } else { $hashref = {}; } return $hashref; } sub get_method { my $self = shift; my $method = shift; my $rsp = $self->execute_method('flickr.reflection.getMethodInfo', {'method_name' => $method}); my $hash = $rsp->as_hash(); my $desc = {}; $rsp->_propagate_status($self->{flickr}->{status}); my $err; my $arg; if ($rsp->success() == 1) { $self->_set_status(1,"flickr.reflection.getMethodInfo returned was successful"); $desc->{$method} = $hash->{method}; foreach $err (@{$hash->{errors}->{error}}) { $desc->{$method}->{error}->{$err->{code}}->{message} = $err->{message}; $desc->{$method}->{error}->{$err->{code}}->{content} = $err->{content}; } if ( ref($hash->{arguments}->{argument}) eq 'ARRAY') { foreach $arg (@{$hash->{arguments}->{argument}}) { $desc->{$method}->{argument}->{$arg->{name}}->{optional} = $arg->{optional}; $desc->{$method}->{argument}->{$arg->{name}}->{content} = $arg->{content}; } } else { $arg = $hash->{arguments}->{argument}; $desc->{$method}->{argument}->{$arg->{name}}->{optional} = $arg->{optional}; $desc->{$method}->{argument}->{$arg->{name}}->{content} = $arg->{content}; } } else { $self->_set_status(0,"Flickr::API::Reflection get_method failed with response error"); carp "Flickr::API::Reflection get method failed with error code: ",$rsp->error_code()," \n ", $rsp->error_message(),"\n"; } return $desc; } # get_method 1; __END__ =head1 NAME Flickr::API::Reflection - An interface to the flickr.reflection.* methods. =head1 SYNOPSIS use Flickr::API::Reflection; my $api = Flickr::API::Reflection->new({'consumer_key' => 'your_api_key'}); or my $api = Flickr::API::Reflection->import_storable_config($config_file); my @methods = $api->methods_list(); my %methods = $api->methods_hash(); my $method = $api->get_method('flickr.reflection.getMethodInfo'); =head1 DESCRIPTION This object encapsulates the flickr reflection methods. C is a subclass of L, so you can access all of Flickr's reflection goodness while ignoring the nitty-gritty of setting up the conversation. =head1 SUBROUTINES/METHODS =over =item C Returns an array of Flickr's API methods. =item C Returns a hash of Flickr's API methods. =item C Returns a hash reference to a description of the method from Flickr. =back =head1 LICENSE AND COPYRIGHT Copyright (C) 2015, Louis B. Moore This program is released under the Artistic License 2.0 by The Perl Foundation. =head1 SEE ALSO L. L, L L =cut Flickr-API-1.29/lib/Flickr/API/People.pm0000644000175000017500000001071414567143531017103 0ustar ubuntuubuntupackage Flickr::API::People; use strict; use warnings; use Carp; use parent qw( Flickr::API ); our $VERSION = '1.28'; sub _initialize { my $self=shift; my $check; #if $self->api_permissions . . . my $rsp = $self->execute_method('flickr.auth.oauth.checkToken'); if (!$rsp->success()) { $rsp->_propagate_status($self->{flickr}->{status}); carp "\nUnable to validate token. Flickr error: ", $self->{flickr}->{status}->{error_code}," - \"", $self->{flickr}->{status}->{error_message},"\" \n"; $self->_set_status(0,"Unable to validate token, Flickr API call not successful."); } else { $check = $rsp->as_hash(); $self->{flickr}->{token} = $check->{oauth}; $self->_set_status(1,"Token validated."); } return; } sub findByEmail { my $self = shift; my $email = shift; $self->clear_user; unless ($email) { croak 'Usage: $api->findByEmail("an-email-address")'; } my $rsp = $self->execute_method('flickr.people.findByEmail',{'find_email' => $email}); $rsp->_propagate_status($self->{flickr}->{status}); if ($rsp->success == 1) { my $eresult = $rsp->as_hash(); $self->_set_status(1,"flickr.people.findByEmail successfully found " . $email); $self->{flickr}->{user} = $eresult->{user}; } else { $self->_set_status(0,"Unable to find user with: " . $email); } return $self->username; } sub findByUsername { my $self = shift; my $user = shift; $self->clear_user; unless ($user) { croak 'Usage: $api->findByUsername("a_user_name")'; } my $rsp = $self->execute_method('flickr.people.findByUsername',{'username' => $user}); $rsp->_propagate_status($self->{flickr}->{status}); if ($rsp->success == 1) { my $uresult = $rsp->as_hash(); $self->_set_status(1,"flickr.people.findByUsername successfully found " . $user); $self->{flickr}->{user} = $uresult->{user}; } else { $self->_set_status(0,"Unable to find user with: " . $user); } return $self->username; } sub perms { my $self=shift; return $self->{flickr}->{token}->{perms}; } sub perms_caller { my $self=shift; return $self->{flickr}->{token}->{user}->{username}; } sub perms_nsid { my $self=shift; return $self->{flickr}->{token}->{user}->{nsid}; } sub perms_token { my $self=shift; return $self->{flickr}->{token}->{token}; } sub nsid { my $self=shift; return $self->{flickr}->{user}->{nsid}; } sub username { my $self=shift; return $self->{flickr}->{user}->{username}; } sub user { my $self=shift; return $self->{flickr}->{user}; } sub clear_user { my $self=shift; delete $self->{flickr}->{user}; return; } 1; __END__ =head1 NAME Flickr::API::People - Perl interface to the Flickr API's flickr.people.* methods. =head1 SYNOPSIS use Flickr::API::People; my $api = Flickr::API::People->new({'consumer_key' => 'your_api_key'}); or my $api = Flickr::API::People->import_storable_config($config_file); =head1 DESCRIPTION This object encapsulates the flickr people methods. C is a subclass of L, so you can access Flickr's people information easily. =head1 SUBROUTINES/METHODS =over =item C Populates user info with that found for the given email =item C Populates user info with that found for the given username =item C Returns the permission returned by checking this supplied token =item C Returns the username for which the permission applies =item C Returns the token for which the permission applies =item C Returns the nsid for which the permission applies =item C Returns the nsid of the supplied mail or username =item C Returns the username of the supplied mail or username =back =head1 LICENSE AND COPYRIGHT Copyright (C) 2015-2016, Louis B. Moore This program is released under the Artistic License 2.0 by The Perl Foundation. Original version was Copyright (C) 2005 Nuno Nunes, C<< >> This version is much changed and built on the Flickr::API as it appears in 2015. Many thanks to Nuno Nunes for getting this ball rolling. =head1 SEE ALSO L. L, L L =cut Flickr-API-1.29/lib/Flickr/API/Cameras.pm0000644000175000017500000000666514567143531017244 0ustar ubuntuubuntupackage Flickr::API::Cameras; use strict; use warnings; use Carp; use parent qw( Flickr::API ); our $VERSION = '1.28'; sub _initialize { my $self = shift; $self->_set_status(1,'API::Cameras initialized'); return; } sub brands_list { my $self = shift; my $rsp = $self->execute_method('flickr.cameras.getBrands'); my $listref = (); $rsp->_propagate_status($self->{flickr}->{status}); if ($rsp->success() == 1) { foreach my $cam (@{$rsp->as_hash()->{brands}->{brand}}) { push (@{$listref},$cam->{name}); } $self->_set_status(1,"flickr.camera.getBrands returned " . $#{$listref} . " brands."); } else { $self->_set_status(0,"Flickr::API::Cameras Methods list/hash failed with response error"); carp "Flickr::API::Cameras Methods list/hash failed with response error: ",$rsp->error_code()," \n ", $rsp->error_message(),"\n"; } return $listref; } sub brands_hash { my $self = shift; my $arrayref = $self->brands_list(); my $hashref; if ($arrayref) { %{$hashref} = map {$_ => 1} @{$arrayref}; } else { $hashref = {}; } return $hashref; } sub get_cameras { my $self = shift; my $brand = shift; my $rsp = $self->execute_method('flickr.cameras.getBrandModels', {'brand' => $brand}); my $hash = $rsp->as_hash(); my $AoH = {}; my $desc = {}; my $cam; $rsp->_propagate_status($self->{flickr}->{status}); if ($rsp->success() == 1) { $AoH = $hash->{cameras}->{camera}; foreach $cam (@{$AoH}) { $desc->{$brand}->{$cam->{id}}->{name} = $cam->{name}; $desc->{$brand}->{$cam->{id}}->{details} = $cam->{details}; $desc->{$brand}->{$cam->{id}}->{images} = $cam->{images}; } $self->_set_status(1,"flickr.camera.getBrandModels returned " . $#{$AoH} . " models."); } else { $self->_set_status(0,"Flickr::API::Cameras get_cameras failed with response error"); carp "Flickr::API::Cameras get_cameras method failed with error code: ",$rsp->error_code()," \n ", $rsp->error_message(),"\n"; } return $desc; } 1; __END__ =head1 NAME Flickr::API::Cameras - An interface to the flickr.cameras.* methods. =head1 SYNOPSIS use Flickr::API::Cameras; my $api = Flickr::API::Cameras->new({'consumer_key' => 'your_api_key'}); or my $api = Flickr::API::Cameras->import_storable_config($config_file); my @brands = $api->brands_list(); my %brands = $api->brands_hash(); my $cameras = $api->get_cameras($brands[1]); =head1 DESCRIPTION This object encapsulates the flickr cameras methods. C is a subclass of L, so you can access Flickr's camera information easily. =head1 SUBROUTINES/METHODS =over =item C Returns an array of camera brands from Flickr's API. =item C Returns a hash of camera brands from Flickr's API. =item C Returns a hash reference to the descriptions of the cameras for a particular brand. =back =head1 LICENSE AND COPYRIGHT Copyright (C) 2015, Louis B. Moore This program is released under the Artistic License 2.0 by The Perl Foundation. =head1 SEE ALSO L. L, L L =cut Flickr-API-1.29/lib/Flickr/API/Request.pm0000644000175000017500000000706514567143531017314 0ustar ubuntuubuntupackage Flickr::API::Request; use strict; use warnings; use HTTP::Request; use Net::OAuth; use URI; use Encode qw(encode_utf8); use parent qw(HTTP::Request); our $VERSION = '1.28'; sub new { my $class = shift; my $options = shift; my $self; if (($options->{api_type} || '') eq 'oauth') { $options->{args}->{request_method}='POST'; $options->{args}->{request_url}=$options->{rest_uri}; $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A; my $orequest; if (defined($options->{args}->{token})) { $orequest = Net::OAuth->request('protected resource')->new(%{$options->{args}}); } else { $orequest = Net::OAuth->request('consumer')->new(%{$options->{args}}); } $orequest->sign(); my $h = HTTP::Headers->new; $h->header('Content-Type' => 'application/x-www-form-urlencoded'); $h->header('Content-Length' => length($orequest->to_post_body)); $self = HTTP::Request->new( $options->{args}->{request_method}, $options->{rest_uri}, $h, $orequest->to_post_body()); $self->{api_method} = $options->{method}; $self->{api_type} = $options->{api_type}; $self->{unicode} = $options->{unicode} || 0; } else { $self = HTTP::Request->new; $self->{api_method} = $options->{method}; $self->{api_type} = $options->{api_type} || 'flickr'; $self->{unicode} = $options->{unicode} || 0; $self->{api_args} = $options->{args}; $self->{rest_uri} = $options->{rest_uri} || 'https://api.flickr.com/services/rest/'; $self->method('POST'); $self->uri($self->{rest_uri}); } bless $self, $class; return $self; } sub encode_args { my ($self) = @_; my $content; my $url = URI->new('https:'); if ($self->{unicode}){ for my $k(keys %{$self->{api_args}}){ $self->{api_args}->{$k} = encode_utf8($self->{api_args}->{$k}); } } $url->query_form(%{$self->{api_args}}); $content = $url->query; $self->header('Content-Type' => 'application/x-www-form-urlencoded'); if (defined($content)) { $self->header('Content-Length' => length($content)); $self->content($content); } return; } 1; __END__ =head1 NAME Flickr::API::Request - A request to the Flickr API =head1 SYNOPSIS =head2 Using the OAuth form: use Flickr::API; use Flickr::API::Request; my $api = Flickr::API->new({'consumer_key' => 'your_api_key'}); my $request = Flickr::API::Request->new({ 'method' => $method, 'args' => {}, }); my $response = $api->execute_request($request); =head2 Using the original Flickr form: use Flickr::API; use Flickr::API::Request; my $api = Flickr::API->new({'key' => 'your_api_key'}); my $request = Flickr::API::Request->new({ 'method' => $method, 'args' => {}, }); my $response = $api->execute_request($request); =head1 DESCRIPTION This object encapsulates a request to the Flickr API. C is a subclass of L, 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 method. =head1 AUTHOR Copyright (C) 2004, Cal Henderson, Ecal@iamcal.comE OAuth patches and additions Copyright (C) 2014-2016, Louis B. Moore =head1 SEE ALSO L. L, =cut Flickr-API-1.29/lib/Flickr/API/Upload.pm0000644000175000017500000001011114567143531017072 0ustar ubuntuubuntupackage Flickr::API::Upload; use strict; use warnings; use HTTP::Request::Common; use Net::OAuth; use URI; use Carp; use Digest::MD5 qw(md5_hex); use Encode qw(encode_utf8); use parent qw(HTTP::Request); our $VERSION = '1.28'; sub new { my ($class, $args) = @_; my $self; my @params = ( "title", "description", "tags", "is_public", "is_friend", "is_family", "safety_level", "content_type", "hidden" ); my $photo = {}; unless ( -f $args->{photo}->{photo} && -r $args->{photo}->{photo} ) { carp "\nPhoto: ",$args->{photo}->{photo},", is not a readable file.\n"; return; } # # make hashref of valid arguments for an upload, ignore extraneous # $photo->{photo} = $args->{photo}->{photo}; $photo->{async} = $args->{photo}->{async} || '0'; for my $param (@params) { if (defined($args->{photo}->{$param})) { $photo->{$param} = $args->{photo}->{$param}; } } chomp $photo->{'description'}; delete($args->{photo}); $args->{api}->{request_method} = 'POST'; # required to be POST if (($args->{api_type} || '') eq 'oauth') { $args->{api}->{extra_params} = $photo; $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A; my $orequest = Net::OAuth->request('protected resource')->new(%{$args->{api}}); $orequest->sign(); my $buzo = $orequest->to_hash(); my @msgarr; for my $param (sort keys %{$buzo}) { push(@msgarr,$param); push(@msgarr,$buzo->{$param}); } push(@msgarr,'photo'); push(@msgarr, [$photo->{photo}]); $self = POST $args->{api}->{request_url}, 'Content-Type' => 'form-data', 'Content' => \@msgarr; } # if oauth else { my $pixfile = $photo->{photo}; delete $photo->{photo}; $photo->{api_key} = $args->{api}->{api_key}; $photo->{auth_token} = $args->{api}->{token}; my $sig = $args->{api}->{api_secret}; foreach my $key (sort {$a cmp $b} keys %{$photo}) { my $value = (defined($photo->{$key})) ? $photo->{$key} : ""; $sig .= $key . $value; } if ($args->{api}->{unicode}) { $photo->{api_sig} = md5_hex(encode_utf8($sig)); } else { $photo->{api_sig} = md5_hex($sig); } my @msgarr; for my $param (sort keys %{$photo}) { push(@msgarr,$param); push(@msgarr,$photo->{$param}); } push(@msgarr,'photo'); push(@msgarr, [$pixfile]); $self = POST $args->{api}->{request_url}, 'Content-Type' => 'form-data', 'Content' => \@msgarr; } # else i'm flickr bless $self, $class; return $self; } sub encode_args { my ($self) = @_; my $content; my $url = URI->new('https:'); if ($self->{unicode}){ for my $k(keys %{$self->{api_args}}){ $self->{api_args}->{$k} = encode_utf8($self->{api_args}->{$k}); } } $url->query_form(%{$self->{api_args}}); $content = $url->query; $self->header('Content-Type' => 'application/x-www-form-urlencoded'); if (defined($content)) { $self->header('Content-Length' => length($content)); $self->content($content); } return; } 1; __END__ =head1 NAME Flickr::API::Upload - An upload via the Flickr API =head1 SYNOPSIS =head2 Using the OAuth form: use Flickr::API; use Flickr::API::Upload; my $api = Flickr::API->import_storable_config($config_file); my $response = Flickr::API->upload({ 'photo' => 'path/to/photo, 'async' => 0, 'title' => 'My vacation picture', 'description' => 'Here I am, riding a horse', }); =head1 DESCRIPTION This modules does most of the work for the upload method in Flickr::API. =head1 AUTHOR Copyright (C) 2016, Louis B. Moore =head1 SEE ALSO L. L, =cut Flickr-API-1.29/LICENSE0000644000175000017500000002111414567143531013731 0ustar ubuntuubuntuArtistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.