comment on

#!/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--------------------------
[download]
In reply to tk-download-w-progressbar-wget by zentara
Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.

"be consistent"
	PerlMonks