Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

tk-download-w-progressbar-wget

by zentara (Archbishop)
on Oct 18, 2004 at 16:24 UTC ( #400207=sourcecode: print w/replies, xml ) Need Help??
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--------------------------
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://400207]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (6)
As of 2020-09-22 20:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I donít succeed, I Ö










    Results (130 votes). Check out past polls.

    Notices?