comment on

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

In reply to Re: Tk::ProgressBar and system cp by zentara
in thread Tk::ProgressBar and system cp by tame1

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.