#!/usr/bin/perl
use warnings;
use strict;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
use Tk;
require Tk::ProgressBar;

my $file = shift || 'z.mpg';
my $url  = 'http://zentara.zentara.net/~zentara/cgi-bin/up1.cgi';

my $progress = 0;
my $cancel = 0;

$|++;
my $mw  = MainWindow->new;
my $tframe =  $mw->Frame( 
        -background => 'grey45' )->pack( -fill => 'x' );

$tframe->Label(
         -background => 'black',          
         -foreground => 'green',
     -width => 4, 
     -textvariable => \$progress,
     )->pack(-side =>'left');             

$tframe->Label(
         -background => 'black',
     -foreground => 'green',
     -text => '%',
     )->pack(-side =>'left');             

my $pb = $tframe->ProgressBar(
          -length => 500,
          -width  => 20,
          -from   => 0,
          -to     => 100,
          -blocks => 100,
          -colors => [ 0, 'green', 50, 'lightblue', 80, 'yellow' ],
  )->pack(-padx => 10);

my $text = $mw->Scrolled("Text",
                -height => 20,
        -background => 'black',
        -foreground => 'yellow',
         )->pack( -expand => 1, -fill => 'both' );

my $bframe = $mw->Frame( 
            -background => 'grey45' )->pack( -fill => 'x' );

my $button;
$button = $bframe->Button(
         -text       => 'Start Upload',
         -background => 'lightgreen',
         -command    => sub {
                      if($button->cget('-text') eq 'Start Upload'){
                     $button->configure(-text => 'Cancel',
                    -background => 'hotpink');
                         $cancel = 0;
             &upload_it( $url, $file );
             }else{
             $button->configure(-text => 'Start Upload',
                    -background => 'lightgreen');
                         $cancel = 1; 
             }
        
               })->pack(-side => 'left', -padx => 20);


$bframe->Button( -text => 'Exit',
             -background => 'Red',
             -command  => sub { 
             $pb->destroy;
             exit;
         }
         )->pack(-side =>'right',-padx => 20);

MainLoop;
############################################################3

sub upload_it() {
      
    my ( $url , $file) = @_;
    my $size = -s $file;
    my $tot = 0;
    $pb->value(0);
    $progress = 0;
    my $start = time;
    my $starttime = scalar localtime;
    my $message = 
    "\n\n\nUploading $file , size $size to\n$url\n  at $starttime\n ";

    $text->insert('end', $message);
    $text->see('end');

    $HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;
    my $ua = new LWP::UserAgent;

    my $req = POST $url,
      Content_Type => 'multipart/form-data',
      Content      => [ file => [$file] ];

    my $gen = $req->content();
            die unless ref($gen) eq "CODE";

    $req->content(
        sub {
            my $chunk = &$gen();
        if (defined $chunk){ $tot += length($chunk) }
        $progress = int(($tot/$size) *100);
        
        if($cancel){goto END}
        
        $pb->value($progress);
            $mw->update;        
        return $chunk;
        }
    );

    my $res = $ua->request($req);   #do it
    
    if ( $res->is_success ) {
        $text->insert('end', $res->as_string);
    }
    else {
        $text->insert('end',$res->status_line);
    }


END:
 
my $condition = 'Finished';
 if($cancel){
     $condition = 'CANCELLED';
     $cancel = 0;
 }

 my $diff = time - $start;
 my $endtime = scalar localtime;
    
 $message = 
    "$condition $file, at $endtime  total time = $diff seconds\n\n\n "
+;

     $text->insert('end', $message);
     $text->see('end');

$button->configure(-text => 'Start Upload',
           -background => 'lightgreen');

undef $ua;
}
[download]