Re: Tk::ProgressBar and system cp

Don't waste your time trying to make progressbars for a file system copy on a local machine. It will be so slow, and waste cpu, so as to be useless. A network transfer would be different.

Beyond that you have some serious obstacles to overcome in your understanding of how the Tk event loop works, and integrating it with an external program, or a pure perl callback. You also chose a particularly tricky task to perform, because there is no easy way to get a running callback without IPC. You also have the problem of monitoring bytes-transferred vs. file-count. Additionally, the Tk::ProgressBar is a slow widget, and it will not be able to keep up with a fast copy. (shown below).

First, don't create a new mainwindow in your loop, you will gain memory that way. Create 1 mainwindow and work with it.

Second,

while (system($cmd)) {}
[download]

will block the Tk gui from working, until the system command is done.

There are so many ways to approach this, that it is hard to decide which is best. Probably andyford 's idea of a combination of File::Find and File::Copy would be the best. That way would involve first resetiing your progressbar, as you entered each directory, counting the files and totaling their bytes, then copy each file 1 by 1, subtracting the bytes transferred from the total bytes and updating the progressbar. While this would be accurate, it will slow down the actual copy.

Another alternative, would be to run your system command thru IPC::Open3, and update the progressbar in the *READ callback. Then you could run cp with the -v option, to get a printout of each file as it is transferred. So for each line you read, you update progress by 1.

So here are 2 scripts to show the problem. The first uses IPC to make a fast copy, but then the progressbar can't keep up, and you get "deep recursion errors". The second, will give a good progress display, but it is slow and uses too much cpu. So ...... I think you are wasting time trying to write a script like that. I didn't try a threaded version, but I think the result would be the same.... just slowing everything down. You might be able to get away with it, if you only update the progressbar every 10th or 100th increment.

Fast copy, but overwhelms progressbar widget

#!/usr/bin/perl
use warnings;
use strict;
use warnings;
use Tk;
use Tk::ProgressBar;
use IPC::Open3;
use File::Find;

my $count    = 0;
my $tot      = 0;
my $dir_from = '/home/zentara/1down/goodstuff';
my $dir_to   = '/home/zentara/1';

finddepth sub {
   return if $_ eq "." or $_ eq "..";
#  print "$File::Find::name\n";
   $tot++;
}, $dir_from;
print "tot $tot\n";

my $mw = new MainWindow( -title => 'Progress Bar Demo' );
my $top = $mw->Frame()->pack( -expand => 1, -fill => 'both' );

my $percent_done = 0;

my $pb = $top->ProgressBar(
   -width    => 20,
   -height   => 200,
   -from     => 0,
   -to       => 100,
   -blocks   => 10,
   -colors   => [ 0, 'green', 50, 'yellow', 80, 'red' ],
   -variable => \$percent_done
)->pack();

$mw->after( 100 => \&copy_loop );
MainLoop;

sub copy_loop {

#now use IPC to read output of $cmd and
#update progressbar for each file...
#not accurate, but fast but overwhelms progressbar widget

   my $pid = open3( 0, \*READ, 0, "cp -va $dir_from $dir_to" );

   $mw->fileevent( \*READ, 'readable', \&update_pbar );

}

sub update_pbar {
   $_ = <READ>;
   $count++;
   $percent_done = $count / $tot * 100;
   $pb->update;
}
[download]

This one is too slow, and eats cpu, but works. Also copies full path, but it's just a demo.

#!/usr/bin/perl
use warnings;
use strict;
use warnings;
use Tk;
use Tk::ProgressBar;
use File::Find;

my $count = 0;
my $tot   = 0;
my $orig  = '/home/zentara/1down/goodstuff';
my $new   = '/home/zentara/1';

finddepth sub {
   return if $_ eq "." or $_ eq "..";

#  print "$File::Find::name\n";
   $tot++;
}, $orig;
print "tot $tot\n";

my $mw = new MainWindow( -title => 'Progress Bar Demo' );
my $top = $mw->Frame()->pack( -expand => 1, -fill => 'both' );

my $percent_done = 0;
my $pb = $top->ProgressBar(
   -width    => 20,
   -height   => 200,
   -from     => 0,
   -to       => 100,
   -blocks   => 10,
   -colors   => [ 0, 'green', 50, 'yellow', 80, 'red' ],
   -variable => \$percent_done
)->pack();

$mw->after( 100 => \&copy_loop );

MainLoop;

sub copy_loop {
#######################################################
# original by broquiant of perlmonks
   use File::Basename 'basename';
   use File::Find::Rule 'find';
   use File::Path 'mkpath';
   use File::Copy 'copy';
  use File::Spec::Functions qw/ splitdir catdir splitpath catfile /;

   my $iter = find start => $orig;

   while ( my $ent = $iter->match ) {
      if ( -d $ent ) {
         my $mode = ( stat $ent )[ 2 ];
         my @src  = splitdir $ent;
         my $dest = catdir $new => @src;
         mkpath $dest => 0,
          $mode
          or warn " Couldn't create '$ent': $!";
      }
      else {
         my @src  = splitpath $ent;
         my $dest = catfile $new => @src;

         copy $ent => $dest
          or warn " Couldn't copy '$ent': $!";
      }
      $count++;
      $percent_done = $count / $tot * 100;
      $pb->update;
   }
###################################################
}
[download]

I'm not really a human, but I play one on earth. Cogito ergo sum a bum

Comment on Re: Tk::ProgressBar and system cp Select or Download Code