A couple of things.

You only need to construct your progress bar once.  You then manage it by making changes to the variable (in your case, $percent_done).

I had never used Tk::ProgressBar before (I usually just construct my own), so I just tried it, and it's quite easy.

Here's an example that's pretty close to yours, except that it doesn't try to examine files from an array (like @SOURCE), but rather, for purposes of example, just changes the value of $percent_done:

#!/usr/bin/perl -w
                                                                      
+          
use strict;
use warnings;
                                                                      
+          
use Tk;
use Tk::ProgressBar;
                                                                      
+          
my $percent_done = 0;
                                                                      
+          
my $mw  = new MainWindow(-title => 'Progress Bar Demo');
my $top = $mw->Frame()->pack(-expand => 1, -fill => 'both');
my $pb  = $top->ProgressBar(
            -width    => 20,
            -height   => 200,
            -from     => 0,
            -to       => 100,
            -blocks   => 10,
            -colors   => [0, 'green', 50, 'yellow', 80, 'red'],
            -variable => \$percent_done
          );
$pb->pack();
$mw->after(100 => \&main_loop);
MainLoop;
                                                                      
+          
sub main_loop {
    for (my $i = 0; $i < 100; $i++) {
        $percent_done = $i;
        $mw->update();
        select(undef, undef, undef, 0.1);
    }
}
[download]

The delay loop is caused by the code select(undef, undef, undef, 0.1);.

It's important to issue an update to the main window with $mw->update();, otherwise you may never see the meter updating.

All you need to do is put your code in the subroutine main_loop (or whatever you change its name to), and make sure that you update the percentage variable $percent_done in a meangful way.  For example, if you're going by number of files processed $nprocessed, out of a total number of file $total, then $percent_done should be calculated something like:  $percent_done = 100 * $nprocessed / $total.

A final note:  In my experience, you may get a smoother progress meter if you go by total bytes rather than total files, especially in cases where some files are tiny, and some are huge.  The way to do this is make $total equal to the total bytecount (from all the files), and $nprocessed the running count of bytes processed.  Then the same formula should apply.

Good luck!

I haven't use Tk in many years, so I'm no help there, but you will probably need to start by replacing "cp -r" with a combination of File::Find and File::Copy. The modules should give you the control you need to stop periodically and report your progress to the GUI.

There's cpan module too: File::Copy::Recursive.

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]

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.

#!/usr/bin/perl -w

use strict;
use Tk;

use POSIX qw(WNOHANG setsid);
use Errno qw(EAGAIN);
use constant DEBUG => 0;    # Change to 1 to enable debugging
use Quantum::Superpositions;
require Tk::ProgressBar;

## Establish global variables #######################################
my ( $location, $storage, $source, $home, $home_value );
my ( $exclude, $block, $exclusions );
## Done with global variables ######################################

# Spin the message loop
my $main = &create_ui;
MainLoop;

####################################################################
## Make a pretty menu
####################################################################
sub create_ui {

    # Create main window
    my $main = MainWindow->new;

    $main->geometry('+40+40');

    $main->title("Personal Synch Tool");

### Source Directory label and textbox
    $source = $main->Label(
        -text       => 'Source Directory (no trailing /)',
        -background => 'lightgreen',
        -relief     => 'ridge',
      )->pack(
        -expand => 1,
        -side   => 'left',
        -fill   => 'both',
      );

    $source->grid(
        -row        => 1,
        -column     => 0,
        -columnspan => 1,

        #-sticky     => 'w',
        -padx => 2,
        -pady => 4
    );

    $home = $main->Entry( -textvariable => "/home/jrobiso2" );
    $home->grid(
        -row        => 1,
        -column     => 1,
        -columnspan => 1,

        #-sticky     => 'w',
        -padx => 2,
        -pady => 4,
    );

### End Source label and textbox

### Exclusion listing label and textbox
    $exclude = $main->Label(
        -text       => 'Exclusions (seperate by space)',
        -background => 'PaleVioletRed',
        -relief     => 'ridge',
      )->pack(
        -expand => 1,
        -side   => 'left',
        -fill   => 'both',
      );

    $exclude->grid(
        -row        => 2,
        -column     => 0,
        -columnspan => 1,

        #-sticky     => 'w',
        -padx => 2,
        -pady => 4
    );

    $block = $main->Entry( -textvariable => "X Y W" );
    $block->grid(
        -row        => 2,
        -column     => 1,
        -columnspan => 1,

        #-sticky     => 'w',
        -padx => 2,
        -pady => 4,
    );

### End Exclusion listing label and textbox

### Target location label and textbox
    my $label = $main->Label(
        -text       => 'Target Location: ',
        -background => 'lightblue',
        -relief     => 'ridge',
      )->pack(
        -expand => 1,
        -side   => 'left',
        -fill   => 'both',
      );

    $label->grid(
        -row        => 3,
        -column     => 0,
        -columnspan => 1,

        #-sticky     => 'w',
        -padx => 2,
        -pady => 4
    );

    $location = $main->Entry( -textvariable => "/media/usbdisk/" );
    $location->grid(
        -row        => 3,
        -column     => 1,
        -columnspan => 1,

        #-sticky     => 'w',
        -padx => 2,
        -pady => 4,
    );

### End target label and textbox

### Start "Synch" Button
    my $go = $main->Button(
        -text       => 'Synch',
        -command    => \&synch,
        -background => 'green',
      )->pack(
        -expand => 1,
        -side   => 'left',
        -fill   => 'both',
      );
    $go->grid(
        -row        => 4,
        -column     => 0,
        -columnspan => 1,
        -sticky     => 'e w',
    );
### END Synch button

## Start Quit button
    my $quit = $main->Button(
        -text       => 'Quit',
        -justify    => 'right',
        -background => 'red',
        -command    => [ $main => 'destroy' ]
      )->pack(
        -expand => 1,
        -side   => 'right',
        -fill   => 'both',
      );

    $quit->grid(
        -row        => 4,
        -column     => 1,
        -columnspan => 1,
        -sticky     => 'e w',
    );
### END Quit button
}
############# END pretty menu ############################

sub synch {
    ## establish all values needed
    $storage    = $location->get();
    $exclusions = $block->get();
    $home_value = $home->get();
    chomp $storage;
    chomp $home_value;
    chomp $exclusions;

    ### Get exclusions, and add "." and ".." to it.
    my @exclusion_list = split( /\s/, $exclusions );
    push @exclusion_list, ".";
    push @exclusion_list, "..";

    opendir( HOME, $home_value ) || die "Cannot open $home_value: $!";
    my @SOURCE = readdir(HOME);
    closedir(HOME);

    my $tot = $#SOURCE - 1;

    #print "total items: $tot\n";

    unless ( -e $storage ) {
        my $response = $main->messageBox(
            -message => "$storage does not exist or is not mounted\n",
            -title   => "Error!",
            -icon    => 'error',
            -type    => 'RetryCancel',
        );
        if ( $response eq 'Retry' ) {
            synch();
        }
        else { return }
    }

## Progress Bar
    my $count = 0;
    my $mw = new MainWindow( -title => 'Copying Progress Bar' );
    $mw->geometry('+340+340');
    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      => 20,
        -gap         => 0,
        -length      => 400,
        -colors      => [ 0, 'green', 50, 'green', 80, 'green' ],
        -troughcolor => 'red',
        -variable    => \$percent_done
    )->pack();
## End Progress Bar

    foreach my $file (@SOURCE) {
        next if ( $file eq any(@exclusion_list) );

        my $cmd = "cp -au $home_value\/\"$file\" $storage";

        #print "Executing: $cmd\n";

        ## Open a message box to inform regarding the command.
        while (`$cmd`) {    # $$ is the pid returned by the system com
+mand
            my $status = $main->messageBox(
                -message    => 'Executing $cmd',
                -background => 'lightgray',
                -title      => 'Update',
            );
        }
        ## Progress bar update
        $count++;

        #print $count;
        $percent_done = $count / $tot * 100;
        $pb->update;
    }
    ## END Progress Bar update
    ## Now close the progress bar
    $mw->destroy;

    my $response = $main->messageBox(
        -message => "Copying is complete!",
        -title   => "Complete!",
        -type    => 'OK',
    );
    if ( $response eq 'OK' ) {
        exit(0);
    }
    else { return }
}
[download]