?
Solved

Executing an external command asynchronously (non-blocking)

Posted on 2005-03-12
18
Medium Priority
?
2,709 Views
Last Modified: 2012-05-05
I’m developing a Tk script as a front end to a DOS application we use for our stores daily price changes.  The script does a select on an SQL database for a store number and then executes the external program passing the store number (and a couple parameters) to the program.  Once the app completes the processing for the store, another SQL select is done for the next store and then executes the program for that store.

I’m trying to use Tk-ExecuteCommand-1.6 to execute the external program but it seams that it’s not fully compatible/functional on the Windows platform.  It does execute the program asynchronously, however the Perl script is not killing the child process, as it should, once the external program finishes.  I can click on the “cancel” button to kill the process after each “run” but that’s not acceptable.

If I just use a system call [ system("$prch_cmd $options"); ] instead of the module, it will iterate through the stores but, I loose the asynchronous running so the GUI is being blocked.

I’m not sure if I need to modify the module’s code or my script or both.

Here’s a portion of my script.  As soon as I can, I’ll post a link to some screen shots so you can get a better idea of what it's doing.

sub execute {
   my $store = sprintf("%03d", shift);
   my $storedir = "$base_dir/$store";
   my $options;

   $table->refresh;
   if ($cp) {
      system("butil -clone $base_dir\\CP$tomorrow.BTR $base_dir\\CP$yesterday.BTR");
      system("flag $base_dir\\CP$tomorrow.BTR +t");
      $options = "/b /l $store to $store /SR";
      undef $cp;
   }
   else { $options = "/b /l $store to $store /SC /SR"; }

   mkdir $storedir unless -d $storedir;
   chdir $storedir;
   $cmd->configure(-command => "$prch_cmd $options" );
   $cmd->execute_command;
   $cmd->update;
   return stat_pd($store);
} # end -> execute()

sub run_prch_queue {
   $table->refresh;
   my $update;
   my $sth = $dbh->prepare("SELECT Store, Priority
                            FROM queue
                            WHERE status = 0
                            ORDER BY Priority, Store
                            LIMIT 1"
                          );
   $sth->execute();
   my @row = $sth->fetchrow_array();
   if (@row) {
      my $store = $row[0];
      my $priority = $row[1];
      my $status = 1;
      my $start = time();
      $update = $dbh->prepare("UPDATE queue
                               SET Status = $status,
                                   Date = localtime(),
                                   Started = localtime(),
                                   ExecutionHost = '$host',
                                   Run = Run + 1
                               WHERE store = $store"
                             );
      $update->execute();
      $status = execute($store, $cp);
      my $delta = time() - $start;
      $update = $dbh->prepare("UPDATE queue
                               SET Status = $status,
                                   Finished = localtime(),
                                   RunTime = $delta
                               WHERE store = $store"
                             );
      $update->execute();
      run_prch_queue();
   }
} # end -> run_prch_queue()


Here’s the section of code in the module that might need to be modified.

sub execute_command {

    # Execute the command and capture stdout/stderr.

    my($self) = @_;

    $self->{-finish} = 0;
    $self->{-handle} = undef;
    $self->{-pid} = undef;
    $self->{-tid} = undef;
   
    my $h = IO::Handle->new;
    die "IO::Handle->new failed." unless defined $h;
    $self->{-handle} = $h;

    $self->{-pid} = open $h, $self->{-command} . ' 2>&1 |';
    if (not defined $self->{-pid}) {
      $self->Subwidget('text')->insert('end',
            "'" . $self->{-command} . "' : $!\n");
      $self->kill_command;
      return;
    }
    $h->autoflush(1);
    $self->fileevent($h, 'readable' => [\&_read_stdout, $self]);

    my $doit = $self->Subwidget('doit');
    $doit->configure(
        -text    => 'Cancel',
        -relief  => 'raised',
        -state   => 'normal',
        -command => [\&kill_command, $self],
    );

    my $doit_bg = ($doit->configure(-background))[3];
    $self->_flash_doit(-background => $doit_bg, qw/cyan 500/);

    $self->waitVariable(\$self->{-finish});
    $self->kill_command;
   
} # end execute_command
0
Comment
Question by:FishMonger
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 9
  • 5
  • 2
  • +1
18 Comments
 
LVL 84

Expert Comment

by:ozo
ID: 13532903
Can you use
system("$prch_cmd $options &");
0
 
LVL 28

Author Comment

by:FishMonger
ID: 13537875
No, it didn't work as expected.  Not only was the gui was still being blocked but the price change program died with a usage message as it looped through each store number.  Here are some screen shoots


system("$prch_cmd $options &");
http://www.rosysatthebeach.com/fishmonger/prch1.jpg

system("$prch_cmd $options");
http://www.rosysatthebeach.com/fishmonger/prch2.jpg   while executing each store  (only ran 2 stores in these examples)
http://www.rosysatthebeach.com/fishmonger/prch3.jpg   after executing each store

$cmd->configure(-command => "$prch_cmd $options" );
http://www.rosysatthebeach.com/fishmonger/prch4.jpg
http://www.rosysatthebeach.com/fishmonger/prch5.jpg

using Tk::ExecuteCommand module, manually clicking on "Cancel" is required after processing a store before it will kill the child process and proceed to the next store
0
 
LVL 28

Author Comment

by:FishMonger
ID: 13537931
>> clicking on "Cancel" is required after processing a store

That's not how it should work.  The cancel button should only be used to kill the child process before the external program completes.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 28

Author Comment

by:FishMonger
ID: 13700176
Any other ideas on how I can accomplish my goal?  Are there other modules available besides Tk::ExecuteCommand that will allow non-blocking execution of an external program and "inform" the Perl script when the external program completes.  I wonder if Win32::Process would handle this, or should I use IO::Handle or Proc::Spawn.
0
 
LVL 20

Expert Comment

by:jmcg
ID: 13702052
If this were a Tcl/Tk program, I'd ask about whether Expect/Tk would represent any sort of a solution. What's unclear to me is how to organize the interaction with the background command with the event-driven paradigm of the Tk GUI. That seems to be what you're struggling with using Perl/Tk.

Is the background program producing Tk widgets of its own? Or is it doing all of its interaction via sockets or pipes connected to the main script?
0
 
LVL 28

Author Comment

by:FishMonger
ID: 13702981
>> Is the background program producing Tk widgets of its own?
No, it's a (16 bit DOS) program that extracts PLU price info from various databases.  The (jpg) links I previously posted show the running DOS program.

Since I'm executing a "self contained" DOS application that does not produce output to STDOUT, Tk's fileevent that the Tk::EcecuteCommand module uses won't work in this case, infact I've read that fileevent doesn't work on Windows systems.

I tested using the Win32::Process module, but that give me the same results as using a normal system() call.  By that I mean that the program properly executes and when it completes, the script executes the next iteration and launches the program for the next store, however, the GUI is still being blocked until all iterations are complete.

I've combined the 2 subroutines that I previously posted which should make things a little more clear.

sub execute {

   my ($options, $status, $update, @row, $store, $storedir, $corpprch);
   my $sth = $dbh->prepare("SELECT Store
                            FROM queue
                            WHERE status = 'Not Run'
                            ORDER BY Priority, Store
                            LIMIT 1"
                          );
   $sth->execute();
   @row = $sth->fetchrow_array();
   return unless @row;

   $store = sprintf("%03d", $row[0]);
   $status = 'Running';  
   $update = $dbh->prepare("UPDATE queue
                            SET Status = $status,
                                Date = localtime(),
                                Started = localtime(),
                                ExecutionHost = '$host',
                                Run = Run + 1
                            WHERE store = $store"
                          );
   $update->execute();
   $table->refresh;

   if ($cp) {
      system("butil -clone $base_dir\\CP$tomorrow.BTR $base_dir\\CP$yesterday.BTR");
      system("flag $base_dir\\CP$tomorrow.BTR +t");
      $options = "/b /l $store to $store /SR";
      undef $cp;
   }
   else {
      $options = "/b /l $store to $store /SC /SR";
   }

   $storedir = "$base_dir/$store";
   mkdir $storedir unless -d $storedir;
   chdir $storedir or die "could not cd to $storedir $!";

   Win32::Process::Create($corpprch,
                          'F:\\item\\exe\\corpprch.exe',
                          "corpprch $options",
                          0,
                          DETACHED_PROCESS,
                          ".") || die Win32::FormatMessage( Win32::GetLastError() );

   $corpprch->Wait(INFINITE);

#   system("$prch_cmd $options");

#   $cmd->configure(-command => "$prch_cmd $options" );
#   $cmd->execute_command;
#   $cmd->update;

   $status = stat_pd($store);
   $update = $dbh->prepare("UPDATE queue
                            SET Status = $status,
                                Finished = localtime(),
                                RunTime = localtime() - Started
                            WHERE store = $store"
                          );
    $update->execute();
    $table->refresh;  
    execute();

} # end -> execute()
0
 
LVL 18

Expert Comment

by:kandura
ID: 13712141
This may be a bridge too far, but you might want to take a look at POE. It's an event driven system that works well with Tk. It also has a lot of options to control external programs, for instance through POE::Wheel::Run.
POE has a steep initial learning curve, but I think it's well worth the effort. I've used it in a number of large programs that needed to process many requests in parallel, and I'm extremely pleased with it.

For documentation, see search.cpan.org and poe.perl.org (lots of code samples there).
0
 
LVL 28

Author Comment

by:FishMonger
ID: 13712571
POE sounds like it's worth a try.  I'll start reading the docs but in the mean time, do you know it well enough to show me how I might use it and which one of the POE modules besides POE::Wheel::Run would be best for this project?  According to the cpan doc for POE::Wheel::Run "ActiveState Perl doesn't like this module one bit."
0
 
LVL 18

Expert Comment

by:kandura
ID: 13712839
FishMonger,
> According to the cpan doc for POE::Wheel::Run "ActiveState Perl doesn't like this module one bit."

Ah yes, I forgot about that. Maybe POE _is_ overkill. And I do not have experience with it on Windows at all.

Just so I have the facts straight: isn't it possible to update the GUI between iterations? Similar to the good old DoEvents in basic ;)
0
 
LVL 28

Author Comment

by:FishMonger
ID: 13712950
>> isn't it possible to update the GUI between iterations?

Yes it should be possible, and I've tried doing the update at verious points in the script, but for some unknown reason, the GUI still doesn't refresh until all iterations are complete.  I'm now running some tests using fork and $pid = POSIX::waitpid( -1, POSIX::WNOHANG ) but I'm not having much success.  I'm starting to think that it might be better or at least easier to redesign the script and drop the GUI.  After all, I'm also required to write a seperate script to display the sql table in a web page for our store managers.

I installed and am testing POE::Component::Client::Asterisk::Manager (from activestate) for another project and was surprised to see that it installed POE::Wheel::Run.  I started reading its source code and found this: die "$^O does not fully support fork+exec\n" if $^O eq 'MSWin32';
0
 
LVL 18

Expert Comment

by:kandura
ID: 13712973
Yes, fork support on windows is very limited. There was a thread here last year where it turned out that you can fork maybe 16 times, and then it just bombs.
Have you tried running all your iterations in a single forked child? That might just work.
Otherwise I think you may have better luck with threads; they are fairly well developed, even on windows.
0
 
LVL 28

Author Comment

by:FishMonger
ID: 13713126
>> Have you tried running all your iterations in a single forked child?

I don't see how that solves the problem since the GUI will still be blocked while the child process is running.

So far, the Tk::ExecuteCommand has come the closest to doing what I need since it successfully runs in nonblocking mode.  Unfortunately, it relies on fileevent [ $self->fileevent($h, 'readable' => [\&_read_stdout, $self]) ] to determine when the external program finishes which won't work in this case.  I'm tinking that I might be able modify the module so that instead of relying on fileevent, I some how "monitor" the pid and take action when/if it changes, but I'm not sure how to do it.
0
 
LVL 28

Author Comment

by:FishMonger
ID: 13777390
I'm assuming from the silence that no one has any additional ideas.

This project is being put on "the back burner" since I'm taking a 2 month medical leave.  I'm going to ask to have this Q deleted and may ask a more refined one when I get back.
0
 
LVL 18

Expert Comment

by:kandura
ID: 13777528
Sorry to hear you're ill!

I didn't really have anything sensible to contribute anymore. However, I did see some traffic on the POE mailing list today, that POE::Wheel::Run is being patched for Windows. Check the archives if you have the chance.
0
 
LVL 28

Author Comment

by:FishMonger
ID: 13778288
>>  Sorry to hear you're ill!
Thanks, I'm going to have my "ticker" fixed (heart valve & bypass).

I like the idea of using POE::Wheel::Run.  I'll take a closer look at it and post a new Q when I'm back.  The other idea I had was to move this script to a linux box and use dosemu http://www.qsl.net/n0nb/linux/dosemuold.html but even that may not work because of the requirments of the DOS program (i.e., pervasive).
0
 
LVL 18

Expert Comment

by:kandura
ID: 13786071
No objections from me.

In fact, I wish Fishmonger the best of luck with his surgery!
I hope you're not going to be fitted with a stock ticker, haha ;)
0
 
LVL 20

Accepted Solution

by:
jmcg earned 0 total points
ID: 13786743
PAQ with 500 of 500 points refunded.

jmcg
EE Page Editor for Perl
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I have been pestered over the years to produce and distribute regular data extracts, and often the request have explicitly requested the data be emailed as an Excel attachement; specifically Excel, as it appears: CSV files confuse (no Red or Green h…
There are many situations when we need to display the data in sorted order. For example: Student details by name or by rank or by total marks etc. If you are working on data driven based projects then you will use sorting techniques very frequently.…
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
Six Sigma Control Plans

800 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question