| Subject: | [PATCH] Proof of concept progress bar with Term::ProgressBar for flickr_upload |
I was trying to hack around progress.t not working. As I'm sure you've
noticed 'decode_content' doesn''t support multipart chunks.
I made a superhacky hackidee hack to hack around that which is good
enough for me, so here's a patch.
| Subject: | flickr_upload-progressbar.patch |
From 3d802b5795e9be25aebadb0a6f782960c506b733 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avar@cpan.org>
Date: Sun, 4 May 2008 21:53:59 +0000
Subject: [PATCH] Support a --progress switch which displays a progress bar with
Term::ProgressBar, this doesn't update the tests or the makefile and
is only an example, not a ready-to-realease patch.
---
flickr_upload | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
1 files changed, 74 insertions(+), 2 deletions(-)
diff --git a/flickr_upload b/flickr_upload
index a8ccaef..73e54e7 100755
--- a/flickr_upload
+++ b/flickr_upload
@@ -3,6 +3,7 @@
use strict;
use warnings;
use Flickr::Upload;
+use Term::ProgressBar 2.00;
use Getopt::Long;
use Pod::Usage;
@@ -15,6 +16,7 @@ my @tags = ();
my $help = 0;
my $man = 0;
my $auth = 0;
+my $progress = 0;
if( open CONFIG, "< $ENV{HOME}/.flickrrc" ) {
while( <CONFIG> ) {
@@ -47,6 +49,7 @@ GetOptions(
'key=s' => \$api_key,
'secret=s' => \$not_so_secret,
'auth' => \$auth,
+ 'progress' => \$progress,
'option=s' => \%args,
) or pod2usage(2);
pod2usage(1) if $help;
@@ -101,9 +104,41 @@ my %tickets;
$| = 1;
while( my $photo = shift @ARGV ) {
- print 'Uploading ', $photo, '...';
+ my $rc;
+
+ if ($progress) {
+ $HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;
+ my $photo_size = (stat($photo))[7];
+ my $req = $ua->make_upload_request( 'photo' => $photo, %args );
+ my $gen = $req->content();
+ die unless ref($gen) eq "CODE";
+
+ my $progress = Term::ProgressBar->new({
+ name => $photo,
+ count => $photo_size,
+ ETA => 'linear',
+ });
+
+ my $line = 0;
+ my $byte_count = 0;
+ $req->content(
+ sub {
+ my $chunk = &$gen();
+ $line += 1;
+
+ $byte_count += file_length_in_encoded_chunk($line, \$chunk);
+ $progress->update($byte_count);
+
+ return $chunk;
+ }
+ );
+
+ $rc = $ua->upload_request( $req );
+ } else {
+ print 'Uploading ', $photo, '...';
+ $rc = $ua->upload( 'photo' => $photo, %args );
+ }
- my $rc = $ua->upload( 'photo' => $photo, %args );
# let the caller know how many images weren't uploaded
exit (1+@ARGV) unless defined $rc;
@@ -180,6 +215,39 @@ sub getToken {
return $res->{tree}->{children}->[1]->{children}->[1]->{children}->[0]->{content};
}
+# Since decode_content doesn't work on multipart chunks this is a
+# dirty hack to figure out how much of a file is present in a HTTP
+# stream given a chunk number and the content of the chunk. In the
+# first few chunks we strip out other HTTP headers and subtract their
+# length from our count. This is superevil and may only work on my LWP
+# version.
+sub file_length_in_encoded_chunk
+{
+ my ($n, $ref) = @_;
+ my $chunk = $$ref;
+ my $size = length $chunk;
+
+ if ($n == 1)
+ {
+ return 0;
+ }
+ elsif ($n == 2)
+ {
+ my ($garbage) = $chunk =~ m[^ (.*? Content-Type:\ \w+/\w+ \r\n)]xs;
+ # 2: HACK: There's a stray newline somewhere in the
+ # /Content-Disposition hack/, hack more around it.
+ return $size - length($garbage) - 2;
+ }
+ elsif ($chunk =~ /Content-Disposition: /)
+ {
+ return 0;
+ }
+ else
+ {
+ return $size;
+ }
+}
+
__END__
=head1 NAME
@@ -203,6 +271,10 @@ against other API keys/secrets (i.e. for embedding in scripts).
=over 4
+=item --progress
+
+Display a progress bar with L<Term::ProgressBar>
+
=item --auth
The C<--auth> flag will cause L<flickr_upload> to generate an
--
1.5.3.6.gea559