Bagarre has asked for the wisdom of the Perl Monks concerning the following question:

OK...

I think I have somethig close to what I am doing.

Instead of sleep x; imagine those are various Win32::Lanman calls that take from 1 to 5 seconds each.

I changed it to a Pulldown Menu to better show the lag in the gui. It's almost bearable if I tear off the menu and pepper my code with $mw->update(); but, that seems like cheating.

Any comments on how I'm trying to do this or my code in general are more than welcome.

Here's what I did:

#! c:\perl\bin\perl.exe
use Tk;
use Tk::ProgressBar;
use strict; # Had to turn off because of how I build %Items
use warnings;

my $pause = 0;
my $count = 0;
my %Items;
# Just to build the hash. It's actualy a nest of other data under it.
# {'status'}.. {'message'}.. {'tasks'}.. {'history'}[$histcount++]....
+                             
until ($count >= 10 )
    {
    $Items{$count}{'status'} = "1"; 
    $count++;
    }
             
my $mw = new MainWindow(-title => "demo");
$mw->configure(-menu => my $menubar = $mw->Menu);
my $control = $menubar->cascade(-label => "~Control");

$control->command( -label => "Run",
                   -command => \&a_long_process );
$control->command( -label => "Pause",
                     -command => sub {$pause = 1;} );
$control->command( -label => "Resume",
                     -command => sub {$pause = 0; } );
$control->command( -label => "Run",
                     -command => sub{exit;});


my $F_Status = $mw->Frame( -relief => 'groove')->pack(-side   => 'bott
+om', 
                                                      -expand => 1,
                                                      -fill   => 'x');

$F_Status->Label(-text => ' Status:')->pack( -side => 'left');
$F_Status->Label(-textvariable => \$pause )->pack( -side => 'left');
my $F_Status_Target;
# Build P-Bars
foreach (keys %Items )
  {
  $F_Status_Target = $mw->Frame( -relief => 'raised',
                                        -borderwidth => 1);
  $F_Status_Target->pack( -side => 'bottom' );
  $F_Status_Target->Label( -text => $_, -width => 5 )->pack( -side => 
+'left');
  $F_Status_Target->ProgressBar(
        -from => 0,
        -to => 500,
        -blocks => 500,
        -colors => [0, 'blue'],
        -variable => \$Items{$_}{'p_bar'}
     )->pack( -side => 'left');
     $Items{$_}{'p_bar'} = 10; # Initial set
  }
  
  
MainLoop;

sub a_long_process 
  {
  foreach $_ (keys %Items )
    {
    print "$_\n";
    sleep 5; # In my case, map a drive, copy a file, schedule a task..
+..
    $Items{$_}{'p_bar'} = 100;
    $mw->update(); 
    sleep 2; # In my case, map a drive, copy a file, schedule a task..
+..
    $Items{$_}{'p_bar'} = 300;
    $mw->update(); 
    sleep 4; # In my case, map a drive, copy a file, schedule a task..
+..
    $Items{$_}{'p_bar'} = 500;
    $mw->update(); 
    if ($pause) 
      {
      while(1)
        {
        select(undef,undef,undef,0.1);
        last unless $pause;
        $mw->update(); 
        }
      }
   }
}

[download]



Below is my original post
Hello all,

I just made a nice gui from Tk (first time) for a program I wrote. It allows you to load up a config file, designate tasks... and a bunch of status bars and other stuff. The problem is, when I press the "Run" button, the gui freezes until the program is done, and then updates all the status bars and such.
I need to fork off the 'run_program' subroutine so I can return to Mainloop() but, then I loose control of the child and I still don't know the status of the program. (Everything I need is an a hash of hashes that is being built as 'run_program' runs.
IPC::Shareable sounds like it would fix all of my problems but, I'm running Win32... Is there a way this easily?
I've been banging on this for the last two days and haven't come up with anything yet except for a very complex set of pipes between programs.

Thanks for any help
-David

Replies are listed 'Best First'.
Re: Give me my gui back!
by pg (Canon) on Nov 18, 2003 at 01:40 UTC

    Hope this helps. Try the following demo code, first run it as is, then comment out that $mw->update() line, run it again, and see what happens.

    • With update() line, the status is reported back to you right the way from time to time.
    • Without it, your GUI hangs, and nothing gets reported until the whole process is done.

    (When you try it, you may want to adjust those big numbers base on the speed of your machine.)

    use Tk;
use Tk::ProgressBar;
use strict;
use warnings;

my $count;

my $mw = new MainWindow(-title => "demo");
$mw->Button(-command => [\&a_long_process, \$count], -text => "A Long 
+Process")->pack();
my $pb = $mw->ProgressBar(
        -from => 0,
        -to => 100000,
        -blocks => 100000,
        -colors => [0, 'green', 30000, 'yellow' , 60000, 'red'],
        -variable => \$count
)->pack();
MainLoop;

sub a_long_process {
    my $hash = {};
    for (0..100000) {
        $hash->{$_} = $_;
        $count ++;
        $mw->update(); #try to comment and uncomment this
        ;
    }
}

    [download]
[reply]
[d/l]
[select]
Re: Give me my gui back!
by PodMaster (Abbot) on Nov 18, 2003 at 01:57 UTC
    Yes, no, not really, however, it's very easy to do with wxPerl (even easier if you use wxGlade to build the GUI bits, like I just did)

    In the example, just click the button, which will run the app again, then close it (all the while keepin' an eye on the console). 

    #!/usr/bin/perl -w -- 
# generated by wxGlade 0.3.1 on Mon Nov 17 17:52:26 2003
# To get wxPerl visit http://wxPerl.sourceforge.net/

use Wx 0.15 qw[:allclasses];
use strict;

package MyFrame;

use Wx qw[:everything];
use base qw(Wx::Frame);
use strict;

sub new {
    my( $self, $parent, $id, $title, $pos, $size, $style, $name ) = @_
+;
    $parent = undef              unless defined $parent;
    $id     = -1                 unless defined $id;
    $title  = ""                 unless defined $title;
    $pos    = wxDefaultPosition  unless defined $pos;
    $size   = wxDefaultSize      unless defined $size;
    $name   = ""                 unless defined $name;

# begin wxGlade: MyFrame::new

    $style = wxDEFAULT_FRAME_STYLE 
        unless defined $style;

    $self = $self->SUPER::new( $parent, $id, $title, $pos, $size, $sty
+le, $name );
        $self->{button_1} = Wx::Button->new($self, -1, "button_1");

    use Wx::Event qw[ EVT_END_PROCESS  EVT_BUTTON ];
    EVT_END_PROCESS( Wx::wxTheApp(),-1, sub{warn("it ended @_")});
    EVT_BUTTON( $self->{button_1}, $self->{button_1},
        sub { 
            my $fpid = Wx::ExecuteArgs( # start this program again
                [ $^X, __FILE__ ],
                Wx::wxEXEC_ASYNC(),
                Wx::Process->new()
            );
            warn("it started $fpid");
        },
    );

    $self->__set_properties();
    $self->__do_layout();

    return $self;

# end wxGlade
}


sub __set_properties {
    my $self = shift;

# begin wxGlade: MyFrame::__set_properties

        $self->SetTitle("frame_1");

# end wxGlade
}

sub __do_layout {
    my $self = shift;

# begin wxGlade: MyFrame::__do_layout

        $self->{sizer_1} = Wx::BoxSizer->new(wxVERTICAL);
        $self->{sizer_1}->Add($self->{button_1}, 0, 0, 0);
        $self->SetAutoLayout(1);
        $self->SetSizer($self->{sizer_1});
        $self->{sizer_1}->Fit($self);
        $self->{sizer_1}->SetSizeHints($self);
        $self->Layout();

# end wxGlade
}

# end of class MyFrame

1;

package MyApp;

use base qw(Wx::App);
use strict;

sub OnInit {
    my( $self ) = shift;

    Wx::InitAllImageHandlers();

    my $frame_1 = MyFrame->new();

    $self->SetTopWindow($frame_1);
    $frame_1->Show(1);

    return 1;
}
# end of class MyApp

package main;

unless(caller){
    my $app = MyApp->new();
    $app->MainLoop();
}
__END__
it started 884 at C:\dev\loose\wx.proc.pl line 40.
it started 1376 at C:\dev\loose\wx.proc.pl line 40.
it started 1208 at C:\dev\loose\wx.proc.pl line 40.
it ended MyApp=HASH(0x1ab5224) Wx::ProcessEvent=SCALAR(0x2a37114) at C
+:\dev\loose\wx.proc.pl line 32.
it ended MyApp=HASH(0x1ab5224) Wx::ProcessEvent=SCALAR(0x2a37114) at C
+:\dev\loose\wx.proc.pl line 32.
it ended MyApp=HASH(0x1ab5224) Wx::ProcessEvent=SCALAR(0x2a37114) at C
+:\dev\loose\wx.proc.pl line 32.

    [download]

    MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
    I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
    ** The third rule of perl club is a statement of fact: pod is sexy.

[reply]
[d/l]
Re: Give me my gui back!
by sauoq (Abbot) on Nov 18, 2003 at 01:32 UTC

    It would probably be easier to help if you showed us your code. The relevant bits at least.

    It sounds like you already know that the problem is you are attempting to subvert the event loop... as for the best solution... well, that depends.

    -sauoq
"My two cents aren't worth a dime.";
[reply]
      I'm going to post here real quick and then pick it up tomorrow morning..

      sauoq, The snipet of code that pg posted is pretty close to the idea except, i need to be able to pause/resume/exit the 'for' loop from the gui at will..

      I could post an example code tomorrow of the way I am doing it now. The whole program is sitting at about 2,000 lines total... I'll have to scratch something basic to give you a better idea of it.

      My head is a little too foggy right now to work on it anymore. :(

      PodMaster, I thought about learning wxPerl as my gui choice but, decided on Tk becasue I could find more documentation on it. Maybe I should go back and give it a second look after I go thru your code you posted.

      As a reference, I've been writing in PERL for the last four years or so with no formal programming schools. Everything I've learned has been on my own... From the seat of my pants or pulled out of a near by place. :) That being said, sometimes I miss the easier ways of doing things. I appreciate the help folks! -David www.packet-security.com
[reply]
        The snipet of code that pg posted is pretty close to the idea except, i need to be able to pause/resume/exit the 'for' loop from the gui at will..

        Building on pg's example, adding pause and resume is fairly simple: 

        use Tk;
use Tk::ProgressBar;
use strict;
use warnings;

my $count;
my $pause = 0;

my $mw = new MainWindow(-title => "demo");
$mw->Button(-command => [\&a_long_process, \$count], 
            -text => "A Long Process")->pack();

$mw->Button(-text => 'Quit',
            -command => sub{exit})->pack();
$mw->Button(-text => 'Pause', 
            -command => sub{$pause = 1})->pack();
$mw->Button(-text => 'Resume', 
            -command => sub{$pause = 0})->pack();


my $pb = $mw->ProgressBar(
        -from => 0,
        -to => 100000,
        -blocks => 100000,
        -colors => [0, 'green', 30000, 'yellow' , 60000, 'red'],
        -variable => \$count
)->pack();

MainLoop;

sub a_long_process {
    my $hash = {};
    for (0..100000) {
        $hash->{$_} = $_;
        $count ++;
        $mw->update(); 
        if ($pause) {
            while(1){
                select(undef,undef,undef,0.1);
                last unless $pause;
                $mw->update(); 
            }
        }
    }
}

        [download]

        I used select for subsecond sleeping, Time::HiRes could also be used.

[reply]
[d/l]
Re: Give me my gui back!
by etcshadow (Priest) on Nov 18, 2003 at 01:51 UTC
    Well, I think that, at a high level, what you want to do is to treat the running sub-process as a source of events for your main loop.

    Essentially, when you fork off the child, open a pipe to read from it (bi-directional would be harder, but still possible). Here's the basic idea: 

    $pid = open(KID_TO_READ, "-|");
die "Unable to fork: $!\n" unless defined $pid;

if (!$pid) {   # child
   exec($program, @options, @args) or die "Can't exec $program: $!\n";
}

    [download]
    Then, in your main-loop, do a non-blocking read from KID_TO_READ. (There are plenty of good examples around here of how to use IO::Select for non-blocking reads.) Anyway, you take that non-blocking read as an additional source of incoming events into your main loop. That way, you can be kept constantly abrest of the status of the executing job.

    Also, since you've got the pid of the executing job, you can tie a button in your GUI to send a signal (like INT to stop, etc) to your job.


    ------------
    :Wq
    Not an editor command: Wq
[reply]
[d/l]
Re: Give me my gui back!
by zentara (Cardinal) on Nov 18, 2003 at 15:15 UTC
    I think the Tk::ExecuteCommand module is what you might want. Try running the following script and see if you get ideas. 
    #!/usr/bin/perl -w
use Tk;
use Tk::ExecuteCommand;
use Tk::widgets qw/LabEntry/;
use strict;

my $mw = MainWindow->new;

my $ec = $mw->ExecuteCommand(
    -command    => '',
    -entryWidth => 50,
    -height     => 10,
    -label      => '',
    -text       => 'Execute',
                                  )->pack;
$ec->configure(-command => 'date; sleep 10; date');
$ec->execute_command;

MainLoop;

    [download]
[reply]
[d/l]

      Tk::ExecuteCommand is not in my package.

      I'm using ActivePERL 5.8.0 and Tk 800.024

      I saw it mentioned in Mastering Perl/Tk but, they built their own module in the book.

      Does that code work on your box? Where can I get Tk::ExecuteCommand?

      -David

[reply]
        Tk-ExecuteCommand is available through PPM for ActivePerl on Windows.

        It doesn't help you since it sounds look you need to parse the output from the command. The important part is the fileevent call which setups an event handler for non-blocking IO from the handle. The handle can be a pipe to a sub-command. I think this is describe in the "Mastering Perl/Tk" book.

[reply]
[d/l]
      This won't work on windows
[reply]
      This will still freeze the gui on windows, not very useful at all.
[reply]
Re: Why not replace MainLoop?
by Anonymous Monk on Nov 19, 2003 at 01:39 UTC
    I'm scratching my head wondering why nobody mentioned just replacing MainLoop() entirely? Yeah, I guess you have to sort of turn your code kind of inside out, but: 
    
  while (1) {
    if ($Quit) {
      $MW->destroy;
      last;
    }
    DoOneEvent($Running ? Tk::DONT_WAIT : Tk::ALL_EVENTS);
    iterate()           if ($Running);
    save_is_active( 1 ) if (!$Running && !$SaveButtonActive);
  }

    [download]
    If iterate() is particularly long, you still need to spice with the occasional DoOneEvent (I did anyway). The inspiration for this came out of some of the sample code. -- Fred m3047 Morris
[reply]
[d/l]

      This one would work well but, if I have to stick DoOneEvent's thru the routine, I'm back to putting ->update...

      I've narrowed my problem down to a few particular subroutines in particular situations and, for that, I can use fork(). Those routines only return true or false anyway so, the pipe would be simple :)

      So, I guess my problem wasnt as terrible as I thought it was.

      Thanks to all for the help with this. It's been a great learning experience for me! Not too sure if Tk is my cup of tea tho. Seems like a lot of work just for a user to click a button and watch the dancingteddy bear while the program does what it used to do from the command line ;)

      Cheers,
      -David

[reply]

Back to Seekers of Perl Wisdom