http://qs321.pair.com?node_id=400207
Category: GUI Programming
Author/Contact Info zentara@zentara.net
Description: A few people have asked recently how to do a download in Tk, that won't block the GUI and has a download indicator. Well there are a few ways to do it. This one uses Tk::ExecuteCommand to run wget. It will download multiple files with separate indicators. You modify the wget command to do "resumes", "no-clobbers", or if you want to test on a local machine, you can -set-limit to throttle the download. Just look for the wget line, for examples. It hasn't been thoroughly tested, but works for me, and should give you an idea on how to get at the sub-widgets of ExecuteCommand. It also contains a little trick to give a variable-width icon for displaying progress when iconified. The wget method is nicer than using lwp, since it allows for resuming incomplete downloads.
#!/usr/bin/perl -w
use Tk;
use Tk::ExecuteCommand;
use strict;

#by zentara of perlmonks 
my $mw = MainWindow->new(-background => 'gray50');
my %downloads;

#--makes indicator icons------------------------------ 
my $downico = <<"EOD";
/* XPM */
static char * pixmap[] = {
/* width height num_colors chars_per_pixel */
"  16     12       3            1         ",
/* colors */
"   s None  c None",
".  c black",
"X  c yellow",
/* pixels */
"......XXX.......",
"......XXX.......",
"......XXX.......",
"......XXX.......",
"......XXX.......",
"......XXX.......",
".XXXXXXXXXXXXX..",
"..XXXXXXXXXXX...",
"...XXXXXXXXX ...",
"....XXXXXXX.....",
".....XXXXX......",
"......XXX......."};
EOD
my $dicon = $mw->Pixmap(-data => $downico );

my $downicob = <<"EOD";
/* XPM */
static char * pixmap[] = {
/* width height num_colors chars_per_pixel */
"  16     12       3            1         ",
/* colors */
"   s None  c None",
".  c black",
"X  c yellow",
/* pixels */
"................",
"................",
"................",
"................",
"................",
"................",
"................",
"................",
"................",
"................",
"................",
"................"};
EOD
my $diconb = $mw->Pixmap(-data => $downicob );


#frame to hold mw indicators 
my $indframe = $mw->Frame(-background =>'gray50')->pack(-fill =>'x');

my $button = $indframe->Button(-text =>'Download a file',
                         -background =>'lightgreen',
                         -command => sub{ &get_a_file($indframe) } #pa
+ss frame 
                              )->pack(-side=>'left', -padx=> 10);

my $text  = $mw->Scrolled("Text",-scrollbars => 'ose',
                                 -background => 'black',
                                 -foreground => 'lightskyblue',
                                  )->pack;

my $bottomframe = $mw->Frame(-background => 'gray50')->pack;

my $repeat;
my $startbut;
my $repeaton = 0;
$startbut = $bottomframe->Button(
            -text=>'Start Test Count',
            -background =>'hotpink',
            -command =>sub{
               my $count = 0;
               $startbut->configure(-state => 'disabled');
               $repeat = $mw->repeat(100,
                       sub{
                          $count++;
                          $text->insert('end',"$count\n");
                          $text->see('end');
                          });
               $repeaton = 1;
               } )->pack(-side=>'left',-padx => 30);

my $stoptbut = $bottomframe->Button(
           -text=>'Stop Count',
           -command =>sub{ $repeat->cancel;
                           $repeaton = 0;
                           $startbut->configure(-state => 'normal');
                         } )->pack(-side=>'right',-padx => 30);

my $exitbut = $bottomframe->Button(
                   -text=>'Exit',
                   -command =>sub{
                              if($repeaton){$repeat->cancel}
                              foreach(keys %downloads){
                               $downloads{$_}{'repeater'}->cancel;
                                if(defined $downloads{$_}{'ec'}){
                                   $downloads{$_}{'ec'}->kill_command;
                                      }
                                 }
                               exit;
                              })->pack(-side=>'right',-padx => 30);

MainLoop;
################################################################ 
sub get_a_file{

 my $indframe = shift;   #which indicator frame to use on mainwindow  
 my $URL = shift || 'http://zentara.net/zentara1.avi';
 #set a default URL 
 my $length = '-';

#dialog to get file url--------------------- 
 require Tk::Dialog;

    my $dialog = $mw->Dialog(
        -background => 'lightyellow',
        -title      => 'Get File',
        -buttons    => [ "OK", "Cancel" ]
    );

    my $hostl = $dialog->add(
        'Label',
        -text       => 'Enter File Url',
        -background => 'lightyellow'
    )->pack();

    my $hostd = $dialog->add(
        'Entry',
        -width => 100,
        -textvariable => \$URL,
        -background   => 'white'
    )->pack();

$dialog->bind('<Any-Enter>' => sub { $hostd->Tk::focus });
if ( $dialog->Show() eq 'Cancel' ){ return }
#---------------------------------------------- 

#check for file already being downloaded 
if( exists $downloads{$URL} ){
       $mw->messageBox(
         -background => 'lightyellow',
         -icon => 'error',
         -message => "$URL is currently being downloaded",
         -type => 'OK'
      );
 &get_a_file($indframe);
 return;
}

my $filename = substr( $URL, rindex( $URL, "/" ) + 1 );

#make an indicator on the mainwindow frame 
$downloads{$URL}{'mwindicator'} = $indframe->Label(
                                   -image => $diconb,
                                   -borderwidth => 0,
                                  )->pack(-side=>'left');

#create a toplevel 
$downloads{$URL}{'top'} = $mw->Toplevel;
my $top = $downloads{$URL}{'top'};
 $top->withdraw;
 my $percent = '0%';
 $top->configure(-background =>'blue', -title =>  "$percent $length $f
+ilename" );


# a little trick to make a constatntly updated icon 
# of variable width for iconified downloaders, works on fvwm2  
my $width = 11*(length "$percent $length $filename") ;
my $downicoz = <<"EOD";
/* XPM */
static char * pixmap[] = {
/* width height num_colors chars_per_pixel */
"  $width   1       1            1         ",
/* colors */
"X c black",
/* pixels */
"X",};
EOD
my $diconz = $mw->Pixmap(-data => $downicoz );
#------------------------------------------- 

$top->iconimage($diconz);

$downloads{$URL}{'ec'} = $top->ExecuteCommand(
    -command    => '',
    -background => 'steelblue',
    -entryWidth => 50,
    -height     => 10,
    -label      => 'File to Retrieve:   ',
    -text       => 'Download',
          )->pack;

my $ec = $downloads{$URL}{'ec'};

# limit rate for local testing 
#  -c will do continuation    -O $filename will save to a filename 
# $ec->configure(-command => "wget --limit-rate=10k -c -O $filename $U
+RL"); 
$ec->configure(-command => "wget  $URL");
#$ec->configure(-command => "wget $URL");  #best for real use 

#----identify subwidgets 
my $dtext = $ec->Subwidget('text')->configure(
                                 -background => 'black',
                                 -foreground => 'green',
                                   );

#comment out this $dentry section to get full wget command 
#in downloader box, with this, only url is shown. 
my $dentry = $ec->Subwidget('command')->configure(
                                 -background => 'white',
                                 -text => $URL,
                                 );

my $dlabel = $ec->Subwidget('label')->configure(
                                 -background => 'black',
                                 -foreground => 'yellow',
                                 -text => 'Downloading Messages and St
+ats',
                                 );

my $dbutton = $ec->Subwidget('doit');
#-------------------------------------------- 
my $tbotf = $top->Frame(-background =>'lightsteelblue')->pack(-fill =>
+'x');

$tbotf->Button(-text=> 'Stop/Close Download',
        -background => 'yellow',
        -command => [sub{ $ec->kill_command;
                      $downloads{$URL}{'repeater'}->cancel;
                      $top->withdraw;
                      my @w = $top->packSlaves;
                      foreach (@w) { $_->packForget; }
                      undef $ec;
                      undef $top;
                      $downloads{$URL}{'mwindicator'}->update;
                      $downloads{$URL}{'mwindicator'}->packForget;
                      $downloads{$URL}=();
                      delete $downloads{$URL};
                     }],
            )->pack(-side => 'left', -padx => 15);

$tbotf->Button(-text=> 'Iconify Downloader',
             -background => 'green',
             -command => sub{ $top->iconify }
            )->pack(-side => 'right', -padx => 15);


 $top->deiconify;
 $top->raise;

#----------------------------------------------- 
#setup link to blinker in mainwindow and track progress 
#setup link to blinker in mainwindow and track progress 

 $downloads{$URL}{'repeater'} = $mw->repeat(10,
      sub{
          my $color = $dbutton->cget('-background');
           if($color eq 'cyan'){
                 $downloads{$URL}{'mwindicator'}->configure(-image => 
+$dicon)
           }else{$downloads{$URL}{'mwindicator'}->configure(-image => 
+$diconb) }

 if(defined $ec){  #needed for case when loop is cancelled midstream 
       my $line = $ec->Subwidget('text')->get('1.0', 'end');

        if($line =~ m/Connection refused/o){
                    $downloads{$URL}{'repeater'}->cancel;
                    $downloads{$URL}{'mwindicator'}->packForget;
                    return;
                    }
                    
        if(length $line > 200){
             ($length) = ($line) =~ m/Length:\s+(\d+,\d+)/go;
             $length ||= ',';
             $length =~ tr/,//d; #need the d   
           }

       my (@percs) = ($line) =~ m/(\d+%)/go;
        if($percs[-1]){$percent = $percs[-1];
                }else{ $percent = '0%'}

     $top->configure( -title =>  "$percent $length $filename" );
     $top->update;

     if($line =~ /FINISHED/go ){
            $downloads{$URL}{'repeater'}->cancel;
             $downloads{$URL}{'mwindicator'}->packForget;
             }


  }
     #test for killed download 
    # 15 Bad file descriptor 
    my @status;
     if(defined $ec){ @status = $ec->get_status }
            if(defined $status[1]){
               if ($status[1] eq 'Bad file descriptor')
                        {$downloads{$URL}{'repeater'}->cancel;
                         $downloads{$URL}{'mwindicator'}->packForget;
                     }
            }
          });
#---------end of mw blinker control---------------         

$ec->execute_command; #this needs to come last 

}
#--------end of get_file sub--------------------------