Subject: | Pull my patches from git://git.nix.is/avar/pm/Flickr-Upload |
My repository at git://git.nix.is/avar/pm/Flickr-Upload has numerous
improvements. Including a fix for RT#50493.
See here for a patch listing: http://git.nix.is/?p=avar/pm/Flickr-
Upload;a=summary
It includes the fix for https://rt.cpan.org/Ticket/Display.html?id=50493
Attached is the output of git format-patch --stdout
77f2d561665af0cef16b6623b0e5c8ea4f929816..
Subject: | my-local-mods.patch |
From 6b2b1a87ccd4eabe66b28db56a2df7bf6e5f0f2b Mon Sep 17 00:00:00 2001
From: =?utf-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avarab@gmail.com>
Date: Wed, 14 Oct 2009 17:12:00 +0000
Subject: [PATCH 1/5] Solve RT#50493. Sometimes Flickr::Upload will die during upload due to network errors.
Before it would do this:
Uploading img_4289.jpg...
junk '500 read failed: Connection reset by peer
' before XML element
and simply die. Now it'll try again in case of errors:
Uploading img_4289.jpg...
Failed uploading attempt attempt 1/3, trying again. [...]
Uploading img_4289.jpg...
---
Upload.pm | 27 +++++++++++++++++----
t/failupload_timeout.t | 60 ++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 82 insertions(+), 5 deletions(-)
create mode 100644 t/failupload_timeout.t
diff --git a/Upload.pm b/Upload.pm
index 69e7e63..048e0f5 100644
--- a/Upload.pm
+++ b/Upload.pm
@@ -268,11 +268,28 @@ sub upload_request {
my $req = shift;
die "expecting a HTTP::Request" unless $req->isa('HTTP::Request');
- my $res = $self->request( $req );
- return () unless defined $res;
+ # 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, $tree);
+ my $tries = 3;
+ for my $try (1 .. $tries) {
+ # Try to upload
+ $res = $self->request( $req );
+ return () unless defined $res;
+
+ if ($res->is_success) {
+ $tree = XML::Parser::Lite::Tree::instance()->parse($res->decoded_content());
+ return () unless defined $tree;
+ last;
+ } else {
+ my $what_next = ($try == $tries ? "giving up" : "trying again");
+ my $status = $res->status_line;
- my $tree = XML::Parser::Lite::Tree::instance()->parse($res->decoded_content());
- return () unless defined $tree;
+ print STDERR "Failed uploading attempt attempt $try/$tries, $what_next. Message from server was: '$status'\n";
+ next;
+ }
+ }
my $photoid = response_tag($tree, 'rsp', 'photoid');
my $ticketid = response_tag($tree, 'rsp', 'ticketid');
diff --git a/t/failupload_timeout.t b/t/failupload_timeout.t
new file mode 100644
index 0000000..1cbcfd7
--- /dev/null
+++ b/t/failupload_timeout.t
@@ -0,0 +1,60 @@
+no strict 'refs';
+no warnings 'redefine';
+use Test::More qw(no_plan);
+BEGIN { use_ok('Flickr::Upload') };
+
+# Overwrite LWP::UserAgent::request to emulate the server closing the
+# connection on us. Which can happen e.g. if the network sucks or if
+# we C-z flickr_upload
+
+BEGIN {
+ our $old_request = *{"LWP::UserAgent::request"}{CODE};
+ our $times = 0;
+}
+
+sub LWP::UserAgent::request {
+ $times ++;
+
+ # Return the real LWP::UserAgent::request
+ if ($times == 3) {
+ *LWP::UserAgent::request = $old_request;
+ goto &LWP::UserAgent::request;
+ }
+
+ bless({
+ _content => "500 Server closed connection without sending any data back\n",
+ _headers => bless({
+ "client-date" => "Wed, 14 Oct 2009 14:44:46 GMT",
+ "client-warning" => "Internal response",
+ "content-type" => "text/plain",
+ }, "HTTP::Headers"),
+ _msg => "Server closed connection without sending any data back",
+ _rc => 500,
+ _request => 'fix',
+ }, "HTTP::Response"),
+}
+
+my $api_key = '8dcf37880da64acfe8e30bb1091376b7';
+my $not_so_secret = '2f3695d0562cdac7';
+
+# grab auth token. If none, fail nicely.
+my $pw = '******';
+open( F, '<', 't/password' ) || (print STDERR "No password file\n" && exit 0);
+$pw = <F>;
+chomp $pw;
+close F;
+
+my $ua = Flickr::Upload->new({'key'=>$api_key, 'secret'=>$not_so_secret});
+ok(defined $ua);
+
+my $rc = $ua->upload(
+ 'photo' => 't/testimage.jpg',
+ 'auth_token' => $pw,
+ 'tags' => "test kernel perl cat dog",
+ 'description' => "Flickr Upload test for $0",
+ 'is_public' => 0,
+ 'is_friend' => 0,
+ 'is_family' => 0,
+);
+
+ok( defined $rc );
--
1.6.2
From 27a4da0cbd6b5556069d7007f692c7c888b6f325 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avarab@gmail.com>
Date: Wed, 14 Oct 2009 17:32:11 +0000
Subject: [PATCH 2/5] "git-log" has been deprecated in favor of "git log"
---
Makefile.PL | 2 +-
1 files changed, 1 insertions(+), 1 deletions(-)
diff --git a/Makefile.PL b/Makefile.PL
index cef266a..322c87b 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -3,7 +3,7 @@ use ExtUtils::MakeMaker;
sub MY::postamble {
return <<END;
ChangeLog: Makefile
- git-log --pretty=fuller --decorate . >ChangeLog
+ git log --pretty=fuller --decorate . >ChangeLog
META.yml: Makefile
touch META.yml
--
1.6.2
From 8d8f04c98438c938ee9894c33cfc2f4a2d0d7ae5 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avarab@gmail.com>
Date: Wed, 14 Oct 2009 17:45:41 +0000
Subject: [PATCH 3/5] Add a --report switch to suppress the "Waiting for upload results" message
Also add a facility to allow the default of --progress and --report to
be changed via the ~/.flickrrc configuration file.
---
flickr_upload | 54 ++++++++++++++++++++++++++++++++++++++----------------
1 files changed, 38 insertions(+), 16 deletions(-)
diff --git a/flickr_upload b/flickr_upload
index 321ad8c..88f81f8 100755
--- a/flickr_upload
+++ b/flickr_upload
@@ -17,6 +17,7 @@ my $man = 0;
my $auth = 0;
my $progress = 0;
my $check = 0;
+my $report = 1;
if( open CONFIG, "< $ENV{HOME}/.flickrrc" ) {
while( <CONFIG> ) {
@@ -28,6 +29,10 @@ if( open CONFIG, "< $ENV{HOME}/.flickrrc" ) {
$api_key = $2;
} elsif( $1 eq "secret" ) {
$not_so_secret = $2;
+ } elsif( $1 eq "progress" ) {
+ $progress = $2;
+ } elsif( $1 eq "report" ) {
+ $report = $2;
} else {
$args{$1} = $2;
}
@@ -51,6 +56,7 @@ GetOptions(
'auth' => \$auth,
'progress' => \$progress,
'check' => \$check,
+ 'report' => \$report,
'option=s' => \%args,
) or pod2usage(2);
pod2usage(1) if $help;
@@ -170,24 +176,26 @@ while( my $photo = shift @ARGV ) {
}
# check
-print "Waiting for upload results (ctrl-C if you don't care)...\n";
-do {
- sleep 1;
- my @checked = $ua->check_upload( keys %tickets );
- for( @checked ) {
- if( $_->{complete} == 0 ) {
- # not done yet, don't do anythig
- } elsif( $_->{complete} == 1 ) {
- # uploaded, got photoid
- print "$tickets{$_->{id}} is at " .
+if( $report ) {
+ print "Waiting for upload results (ctrl-C if you don't care)...\n";
+ do {
+ sleep 1;
+ my @checked = $ua->check_upload( keys %tickets );
+ for( @checked ) {
+ if( $_->{complete} == 0 ) {
+ # not done yet, don't do anythig
+ } elsif( $_->{complete} == 1 ) {
+ # uploaded, got photoid
+ print "$tickets{$_->{id}} is at " .
"http://www.flickr.com/tools/uploader_edit.gne?ids=$_->{photoid}\n";
- delete $tickets{$_->{id}};
- } else {
- print "$tickets{$_->{id}} failed to get photoid\n";
- delete $tickets{$_->{id}};
+ delete $tickets{$_->{id}};
+ } else {
+ print "$tickets{$_->{id}} failed to get photoid\n";
+ delete $tickets{$_->{id}};
+ }
}
- }
-} while( %tickets );
+ } while( %tickets );
+}
exit 0;
@@ -372,6 +380,20 @@ upload an image. The output is the raw results of the API call.
Display a progress bar for each upload with L<Term::ProgressBar>. That
optional module will have to be installed on the system.
+The default can be changed in the configuration file:
+
+ echo progress=1 >~/.flickrrc
+
+=item --report
+
+Report the status of each upload ticket after uploading the batch via
+L<Flickr::Upload's check_upload
+method|Flickr::Upload/check_upload>. On by default.
+
+The default can be changed in the configuration file:
+
+ echo progress=0 >~/.flickrrc
+
=item --key <api_key>
=item --secret <secret>
--
1.6.2
From d9ccd247ca8b59e3e10329c6b4533c97a9ef0d30 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avarab@gmail.com>
Date: Wed, 14 Oct 2009 17:50:41 +0000
Subject: [PATCH 4/5] Make --progress and --report boolean (!) switches in Getopt::Long
This means --no-report and --no-progress can be specified as well as
--report and --progress.
---
flickr_upload | 14 ++++++++------
1 files changed, 8 insertions(+), 6 deletions(-)
diff --git a/flickr_upload b/flickr_upload
index 88f81f8..e28688f 100755
--- a/flickr_upload
+++ b/flickr_upload
@@ -54,9 +54,9 @@ GetOptions(
'key=s' => \$api_key,
'secret=s' => \$not_so_secret,
'auth' => \$auth,
- 'progress' => \$progress,
+ 'progress!' => \$progress,
'check' => \$check,
- 'report' => \$report,
+ 'report!' => \$report,
'option=s' => \%args,
) or pod2usage(2);
pod2usage(1) if $help;
@@ -375,22 +375,24 @@ Checks the authentication token via the flickr.auth.checkToken API call.
This can be used to verify API keys and credentials without trying to
upload an image. The output is the raw results of the API call.
-=item --progress
+=item --progress, --no-progress
Display a progress bar for each upload with L<Term::ProgressBar>. That
optional module will have to be installed on the system.
-The default can be changed in the configuration file:
+The default is not to display a progress bar. That can be changed in
+the configuration file:
echo progress=1 >~/.flickrrc
-=item --report
+=item --report, --no-report
Report the status of each upload ticket after uploading the batch via
L<Flickr::Upload's check_upload
method|Flickr::Upload/check_upload>. On by default.
-The default can be changed in the configuration file:
+The default is to display a report after each upload. That can be
+changed in the configuration file:
echo progress=0 >~/.flickrrc
--
1.6.2
From 5c210ab9bac949075c6a46d5d87718c79f3d6551 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avarab@gmail.com>
Date: Wed, 14 Oct 2009 17:58:20 +0000
Subject: [PATCH 5/5] Add myself to AUTHORS/COPYRIGHT
---
Upload.pm | 7 +++++--
flickr_upload | 4 +++-
2 files changed, 8 insertions(+), 3 deletions(-)
diff --git a/Upload.pm b/Upload.pm
index 048e0f5..c97a917 100644
--- a/Upload.pm
+++ b/Upload.pm
@@ -410,15 +410,18 @@ L<http://flickr.com/services/api/>
L<Flickr::API>
-=head1 AUTHOR
+=head1 AUTHORS
Christophe Beauregard, L<cpb@cpan.org>
+E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason, <avar@cpan.org>
+
=head1 COPYRIGHT AND LICENSE
This module is not an official Flickr.com (or Ludicorp, or Yahoo) service.
-Copyright (C) 2004,2005 by Christophe Beauregard
+Copyright (C) 2004-2008 by Christophe Beauregard and 2008-2009 by
+E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
diff --git a/flickr_upload b/flickr_upload
index e28688f..bf4c2a0 100755
--- a/flickr_upload
+++ b/flickr_upload
@@ -469,10 +469,12 @@ your Flickr profile. You may want to do all that stuff in one place.
Error handling could be better.
-=head1 AUTHOR
+=head1 AUTHORS
Christophe Beauregard, L<cpb@cpan.org>.
+E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason, <avar@cpan.org>.
+
=head1 SEE ALSO
L<flickr.com>
--
1.6.2