in reply to Tk::ProgressBar and a long parsing process

Your problem is going to force you to get down into the code, and understand how the Tk-event-loop works. Think about how a "single-threaded process" runs.....it can only be doing one thing at a time, unless you figure out a way to time slice the execution, to process sub1 for x microseconds, then sub2 for x microseconds, etc,etc. That is why in a Tk (or any gui program), if you run "sleep" or system(), the GUI stops updating while the system command does it's work.

So what is happening in your code, is that when you hit the line "my $result= MyParser->new($file)"; the process devotes all it's time to running that, and Tk is left with no cpu time.

So there are many ways devised to work around it. One would be to go into the MyParser package, and put a "$mw->update" in the loop that processes the file. Now in order to make it work, you may need to pass "$mw" into the package when it is created.

Other things can be done, but you havn't showed the MyParser code. You could run the parser in a thread, a piped open, or IPC::Open3, and alot of examples for doing that abound.

If you cannot change the MyParser package to do some $mw->update's, you could start the Progressbar, then "fork-and-exec" the code that parse the file, and when the parsing is done, cancel the repeat. Of course you will lose percentage accuracy that way, but threads would allow it. Just remember, if you use a thread with Tk, the thread must be created before you create any Tk windows. I usually create a thread, put it to sleep, and control it from Tk thru shared variables. An example is in the readmore. 

#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;

#works on WindowsME ActiveState 5.8.6.811 

my $data = shift || 'date';  #sample code to pass to thread 

my %shash;
#share(%shash); #will work only for first level keys 
my %hash;
my %workers;
my $numworkers = 3;

foreach my $dthread(1..$numworkers){
 share ($shash{$dthread}{'go'});
 share ($shash{$dthread}{'progress'});
 share ($shash{$dthread}{'timekey'});  #actual instance of the thread 
 share ($shash{$dthread}{'frame_open'}); #open or close the frame 
 share ($shash{$dthread}{'handle'});
 share ($shash{$dthread}{'data'});
 share ($shash{$dthread}{'pid'});
 share ($shash{$dthread}{'die'});

 $shash{$dthread}{'go'} = 0;
 $shash{$dthread}{'progress'} = 0;
 $shash{$dthread}{'timekey'} = 0;
 $shash{$dthread}{'frame_open'} = 0;
 $shash{$dthread}{'handle'} = 0;
 $shash{$dthread}{'data'} = $data;
 $shash{$dthread}{'pid'} = -1;
 $shash{$dthread}{'die'} = 0;
 $hash{$dthread}{'thread'} = threads->new(\&work,$dthread);
}


use Tk;
use Tk::Dialog;

my $mw = MainWindow->new(-background => 'gray50');

my $lframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'left' ,-fill=>'y');
my $rframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'right',-fill =>'both' );

my %actives = ();   #hash to hold reusable numbered widgets used for d
+ownloads 
my @ready = ();     #array to hold markers indicating activity is need
+ed 

#make 3 reusable downloader widget sets------------------------- 
foreach(1..$numworkers){
   push @ready, $_;
#frames to hold indicator 
$actives{$_}{'frame'} = $rframe->Frame( -background => 'gray50' );

$actives{$_}{'stopbut'} = $actives{$_}{'frame'}->Button(
        -text       => "Stop Worker $_",
        -background => 'lightyellow',
        -command    => sub {  } )->pack( -side => 'left', -padx => 10 
+);

$actives{$_}{'label1'} = $actives{$_}{'frame'} ->Label(
         -width       => 3,
         -background => 'black',
         -foreground => 'lightgreen',
         -textvariable => \$shash{$_}{'progress'},
    )->pack( -side => 'left' );

$actives{$_}{'label2'} = $actives{$_}{'frame'} ->Label(
         -width       => 1,
         -text        => '%',
         -background  => 'black',
         -foreground  => 'lightgreen',
    )->pack( -side => 'left' );


$actives{$_}{'label3'} = $actives{$_}{'frame'} ->Label(
          -text        => '',
         -background  => 'black',
         -foreground  => 'skyblue',
    )->pack( -side => 'left',-padx =>10 );

}
#-------------------------------------------------- 

my $button = $lframe->Button(
    -text       => 'Get a worker',
    -background => 'lightgreen',
    -command    => sub { &get_a_worker(time) }
           )->pack( -side => 'top', -anchor => 'n', -fill=>'x', -pady 
+=> 20 );
my $text = $rframe->Scrolled("Text",
                   -scrollbars => 'ose',
                   -background => 'black',
                   -foreground => 'lightskyblue',
                   )->pack(-side =>'top', -anchor =>'n');

my $repeat;
my $startbut;
my $repeaton = 0;
$startbut = $lframe->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 => 'top',  -fill=>'x', -pady => 20);

my $stoptbut = $lframe->Button(
    -text    => 'Stop Count',
    -command => sub {
        $repeat->cancel;
        $repeaton = 0;
        $startbut->configure( -state => 'normal' );
    })->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20 )
+;

my $exitbut = $lframe->Button(
    -text    => 'Exit',
    -command => sub {

        foreach my $dthread(keys %hash){
          $shash{$dthread}{'die'} = 1;
          $hash{$dthread}{'thread'}->join
         }

         if ($repeaton) { $repeat->cancel }
           #foreach ( keys %downloads ) { 
           #    #$downloads{$_}{'repeater'}->cancel; 
           #} 
      # $mw->destroy;    
       exit;
      })->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20
+ );


#dialog to get file url--------------------- 
    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 => '',
        -background   => 'white'
    )->pack();

$dialog->bind( '<Any-Enter>' => sub { $hostd->Tk::focus } );

   my $message = $mw->Dialog(
        -background => 'lightyellow',
        -title      => 'ERROR',
        -buttons    => [ "OK" ]
    );

  my $messagel = $message->add(
               'Label',
        -text       => '       ',
        -background => 'hotpink'
    )->pack();
$mw->repeat(10, sub{
   if(scalar @ready == $numworkers){return}

   foreach my $set(1..$numworkers){
     $actives{$set}{'label1'}->
         configure(-text =>\$shash{$set}{'progress'});

         if(($shash{$set}{'go'} == 0) and
            ($shash{$set}{'frame_open'} == 1))
            {
            my $timekey = $shash{$set}{'timekey'};
           $workers{ $timekey }{'frame'}->packForget;
           $shash{$set}{'frame_open'} = 0;
           push @ready, $workers{$timekey}{'setnum'};
           if((scalar @ready) == 3)
              {  }
              $workers{$timekey} = ();
             delete $workers{$timekey};
           }
        }
    });

$mw->MainLoop;
################################################################### 

sub get_a_worker {

   my $timekey = shift;

  $hostd->configure( -textvariable => \$data);
  if ( $dialog->Show() eq 'Cancel' ) { return }

#---------------------------------------------- 
#get an available frameset 
my $setnum;
  if($setnum = shift @ready){print "setnum->$setnum\n"}
    else{ print "no setnum available\n"; return}

$workers{$timekey}{'setnum'} = $setnum;
$shash{$setnum}{'timekey'} = $timekey;

$workers{$timekey}{'frame'} = $actives{$setnum}{'frame'};
$workers{$timekey}{'frame'}->pack(-side =>'bottom', -fill => 'both' );

$workers{$timekey}{'stopbut'} = $actives{$setnum}{'stopbut'};
$workers{$timekey}{'stopbut'}->configure(
         -command => sub {
            $workers{$timekey}{'frame'}->packForget;
            $shash{ $workers{$timekey}{'setnum'} }{'go'} = 0;
            $shash{ $workers{$timekey}{'setnum'} }{'frame_open'} = 0;
            push @ready, $workers{$timekey}{'setnum'};
            if((scalar @ready) == $numworkers)
              {  }
               $workers{$timekey} = ();
               delete $workers{$timekey};
                    });

$workers{$timekey}{'label1'} = $actives{$setnum}{'label1'};
$workers{$timekey}{'label1'}->configure(
              -textvariable => \$shash{$setnum}{'progress'},
               );

$workers{$timekey}{'label2'} = $actives{$setnum}{'label2'};


$workers{$timekey}{'label3'} = $actives{$setnum}{'label3'};
$workers{$timekey}{'label3'}->configure(-text => $timekey);



$shash{$setnum}{'go'} = 1;
$shash{$setnum}{'frame_open'} = 1;
#--------end of get_file sub-------------------------- 
}

################################################################## 
sub work{
  my $dthread = shift;
    $|++;
    while(1){
       if($shash{$dthread}{'die'} == 1){ goto END };

       if ( $shash{$dthread}{'go'} == 1 ){

    eval( system( $shash{$dthread}{'data'} )    );

   foreach my $num (1..100){
          $shash{$dthread}{'progress'} = $num;
       print "\t" x $dthread,"$dthread->$num\n";
       select(undef,undef,undef, .5);
       if($shash{$dthread}{'go'} == 0){last}
       if($shash{$dthread}{'die'} == 1){ goto END };
       }

    $shash{$dthread}{'go'} = 0; #turn off self before returning       
       }else
         { sleep 1 }
    }
END:
}

[download]
I'm not really a human, but I play one on earth. flash japh

In Section Seekers of Perl Wisdom