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

#set a default $url 
my $url = 'http://foobar.net/~user/cgi-bin/up1.cgi';
my @files = @_;
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 $t1frame =  $mw->Frame(
        -background => 'black' )->pack( -fill => 'x' );

$t1frame->Label(
         -background => 'black',
         -foreground => 'lightblue',
         -text => 'URL:',
         )->pack(-side =>'left');

$t1frame->Label(
         -background => 'black',
         -foreground => 'lightblue',
         -width => 50,
         -textvariable => \$url,
         )->pack(-side =>'left');

############################################################## 

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'){
                           if(scalar @files == 0 ){@files =  &get_file
+s};
                           $button->configure(-text => 'Cancel',
                                        -background => 'hotpink');
                                        $cancel = 0;
                                 foreach my $file(@files){
                                   &upload_it( $url, $file);
                                   }
                          $button->configure(-text => 'Start Upload',
                            -background => 'lightgreen');
                           @files = ();

                         }else{
                         $button->configure(-text => 'Start Upload',
                                -background => 'lightgreen');
                         $cancel = 1;
                         }
                      }
                   )->pack(-side => 'left', -padx => 20);
$bframe->Button( -text => 'Select Files',
             -background => 'lightblue',
             -command  => sub {
                         @files = &get_files;
                          }
             )->pack(-side =>'left',-padx => 20);

$bframe->Button( -text => 'Select URL',
             -background => 'lightyellow',
             -command  => sub {
                         $url = &get_url;
                          }
             )->pack(-side =>'left',-padx => 20);


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



if(scalar @files == 0 ){@files =  &get_files};

MainLoop;
############################################################ 
sub get_url{

 my $dlg = $mw->DialogBox(
       -title => 'URL Select',
       -buttons => [qw/Ok Cancel/],
     );
 my $urlin = $url;
 my $urlout;
 my $entry = $dlg->Entry(
       -width => 80,
       -textvariable => \$urlin,
          )->pack();

 if( $dlg->Show() eq 'Ok'){
 $urlout = $entry->get()
 }

return $urlout;
}
############################################################3 
sub get_files{

 my $dlg = $mw->DialogBox(
       -title => 'File Select',
       -buttons => [qw/Ok Cancel/],
     );

 my $f_frame = $dlg->Frame()->pack();

  my @files;
  push @files, $_ for <*>;
  @files = grep {  ! -d } @files;

 my $listbox = $f_frame->Scrolled("Listbox",
    -background => 'white',
    -scrollbars => "oe",
    -selectmode => "extended")->pack;
  $listbox->insert('end', @files);

@files = ();
 if( $dlg->Show() eq 'Ok'){
     my @selected_files = $listbox->curselection;
     for (@selected_files) {
        push @files, $listbox->get($_);
      }
 }

my $message = "\nSelected Files:\n".join "\n", @files;
$text->insert ('end',$message);
$text->see('end');

return @files;
}
################################################################ 

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;
     @files = ();
 }

 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');

undef $ua;
}
[download]