view release on metacpan or  search on metacpan

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

		$oauth{extra_params} = \%args;
		$oauth{request_method} = 'POST';
		$oauth{request_url} = $uri;
		$Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
		my $req = Net::OAuth->request( "protected resource" )->new( %oauth );
		$req->sign();
		my $tmp_body = $req->to_post_body();
		%args = ();
		foreach (split '&', $tmp_body) {
			my ($name, $val) = split '=', $_, 2;
			$args{$name} = URI::Escape::uri_unescape( $val );
		}
	}

	# unlikely that the caller would set up the photo as an array,
	# but...
	if( defined $photo ) {
		$photo = [ $photo ] if ref $photo ne "ARRAY";
		$args{photo} = $photo;
	}

	my $req = POST $uri, 'Content_Type' => 'form-data', 'Content' => \%args;

	return $req;
}

=head2 upload_request

	my $photoid = upload_request( $ua, $request );

Taking (at least) L<LWP::UserAgent> and L<HTTP::Request> objects as
arguments, this executes the request and processes the result as a
flickr upload. It's assumed that the request looks a lot like something
created with L<make_upload_request>. Note that the request must be signed
according to the Flickr API authentication rules.

Returns the resulting identifier of the uploaded photo (or ticket for
asynchronous uploads) on success, C<undef> on failure. According to the
API documentation, after an upload the user should be directed to the
page L<https://www.flickr.com/tools/uploader_edit.gne?ids=$photoid>.

=cut

sub upload_request {
	my $self = shift;
	die "$self is not a LWP::UserAgent" unless $self->isa('LWP::UserAgent');
	my $req = shift;
	die "expecting a HTTP::Request" unless $req->isa('HTTP::Request');

	# Try 3 times to upload data. Without this flickr_upload is bound
	# to die on large uploads due to some miscellaneous network
	# issues. Timeouts on flickr or something else.
	my ($res, $xml);
	my $tries = 3;
	for my $try (1 .. $tries) {
		# Try to upload
		$res = $self->request( $req );
		return () unless defined $res;

		if ($res->is_success) {
			$xml = XMLin($res->decoded_content, KeyAttr=>[], ForceArray=>0);
			return () unless defined $xml;
			last;
		} else {
			my $what_next = ($try == $tries ? "giving up" : "trying again");
			my $status = $res->status_line;

			print STDERR "Failed uploading attempt attempt $try/$tries, $what_next. Message from server was: '$status'\n";
			next;
		}
	}

	my $photoid = $xml->{photoid};
	my $ticketid = $xml->{ticketid};
	unless( defined $photoid or defined $ticketid ) {
		print STDERR "upload failed:\n", $res->decoded_content(), "\n";
		return undef;
	}

	return (defined $photoid) ? $photoid : $ticketid;
}

=head2 file_length_in_encoded_chunk

	$HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;
	my $photo = 'image.jpeg';
	my $photo_size = (stat($photo))[7];
	my $req = $ua->make_upload_request( ... );
	my $gen = $req->content();
	die unless ref($gen) eq "CODE";

	my $state;
	my $size;

	$req->content(
		sub {
			my $chunk = &$gen();

			$size += Flickr::Upload::file_length_in_encoded_chunk(\$chunk, \$state, $photo_size);

			warn "$size bytes have now been uploaded";

			return $chunk;
		}
	);

	$rc = $ua->upload_request( $req );

This subroutine is tells you how much of a chunk in a series of
variable size multipart HTTP chunks contains a single file being
uploaded given a reference to the current chunk, a reference to a
state variable that lives between calls, and the size of the file
being uploaded.

It can be used used along with L<HTTP::Request::Common>'s
$HTTP::Request::Common::DYNAMIC_FILE_UPLOAD facility to implement
upload progress bars or other upload monitors, see L<flickr_upload>
for a practical example and F<t/progress_request.t> for tests.

=cut

sub file_length_in_encoded_chunk
{
	my ($chunk, $s, $img_size) = @_;

	$$s = {} unless ref $$s eq 'HASH';

	# If we've run past the end of the image there's nothing to do but
	# report no image content in this sector.
	return 0 if $$s->{done};

	unless ($$s->{in}) {
		# Since we haven't found the image yet append this chunk to
		# our internal data store, we do this because we have to do a
		# regex match on m[Content-Type...] which might be split
		# across multiple chunks

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

			# This chunk finishes the image

			$$s->{done} = 1;

			# Return what we had left
			return $img_size - $$s->{size};
		} else {
			# This chunk isn't the last one

			$$s->{size} += $size;

			return $size;
		}
	}
}

=head2 photosets_create

	Calls Flickr's "flickr.photosets.create" method,
	to create a new Set.

	The set will use the PrimaryPhotoID as the thumbnail photo.

	returns: UNDEF on failure, PhotosetID on success.

	my $photoset_id = $ua->photosets_create( title => 'title',
	                               description => 'description',
				       primary_photo_id => ID,
				       auth_token => AUTH_TOKEN );

	$ua->photosets_addphoto ( photoset_id => $photoset_id,
	                          photo_id => ID );

=cut
sub photosets_create {
	my $self = shift;
	die '$self is not a Flickr::API' unless $self->isa('Flickr::API');

	my %args = @_;
	carp "Missing 'auth_token' parameter for photosets_create()"
		unless exists $args{'auth_token'};
	my $auth_token = $args{'auth_token'};
	carp "Missing 'title' parameter for photosets_create()"
		unless exists $args{'title'} && length($args{'title'})>0;
	my $title = $args{'title'};
	carp "Missing 'primary_photo_id' parameter for photosets_create()"
		unless exists $args{'primary_photo_id'};
	my $primary_photo_id = $args{'primary_photo_id'};
	carp "Invalid primary_photo_id ($primary_photo_id) value (expecting numeric ID)" unless $primary_photo_id =~ /^[0-9]+$/;
	my $description = ( exists $args{'description'} ) ? $args{'description'} : "" ;

	my $res = $self->execute_method( 'flickr.photosets.create',
		{ 'title' => $title,
		  'description' => $description,
		  'primary_photo_id' => $primary_photo_id,
		  'auth_token' => $auth_token,
	  } ) ;
	#TODO: Add detailed error messages
	return undef unless defined $res and $res->{success};

	my $hash = XMLin($res->decoded_content(), KeyAttr=>[], ForceArray=>0);
	my $photoset_id = $hash->{photoset}->{id};
	if ( ! defined $photoset_id ) {
		warn "Failed to extract photoset ID from response:\n" .
			$res->decoded_content() . "\n\n";
		return undef;
	}
	return $photoset_id  ;
}

=head2 photosets_addphoto

	Calls Flickr's "flickr.photosets.addPhoto" method,
	to add a (existing) photo to an existing set.

	returns: UNDEF on failure, TRUE on success.

	my $photoset_id = $ua->photosets_create( title => 'title',
	                               description => 'description',
				       primary_photo_id => ID,
				       auth_token => AUTH_TOKEN );

	$ua->photosets_addphoto ( photoset_id => $photoset_id,
	                          photo_id => ID );

=cut
sub photosets_addphoto {
	my $self = shift;
	die '$self is not a Flickr::API' unless $self->isa('Flickr::API');

	my %args = @_;
	carp "Missing 'auth_token' parameter for photosets_addphoto()"
		unless exists $args{'auth_token'};
	my $auth_token = $args{'auth_token'};
	carp "Missing 'photoset_id' parameter for photosets_addphoto()"
		unless exists $args{'photoset_id'};
	my $photoset_id = $args{'photoset_id'};
	carp "Missing 'photo_id' parameter for photosets_addphoto()"
		unless exists $args{'photo_id'};
	my $photo_id = $args{'photo_id'};

	my $res = $self->execute_method( 'flickr.photosets.addPhoto',
		{ 'photoset_id' => $photoset_id,
		  'photo_id' => $photo_id,
		  'auth_token' => $auth_token,
	  } ) ;
	#TODO: Add detailed error messages
	return undef unless defined $res;

	return $res->{success};
}

# Private method adapted from Flickr::API
# See: https://www.flickr.com/services/api/auth.howto.web.html
sub _sign_args {
    my $self = shift;
    my $args = shift;

    my $sig = $self->{api_secret};

    for(sort { $a cmp $b } keys %$args) {
        $sig .= $_ . (defined($args->{$_}) ? $args->{$_} : "");
    }

    return md5_hex($self->{unicode} ? encode_utf8($sig) : $sig);