forked process exiting before output read



I have an application which has the option to read image files
including TIFF and PDF. I use tiffsplit or pdfimages to extract the
multiple images from these files and then read them one by one.

As this can take a few seconds, I am adding a ProgressBar, forking a
process to extract the images and examine them, passing various info,
including the filename, back to the parent process, which updates the
GUI.

Sometimes, updating the GUI takes longer than the child process, and
so the child process exits before the GUI has read all the data,
meaning that the last few images are missing. The following code
illustrates the point - the ProgressBar never reaches 100%.

Whilst I realise that I can write the info to a file, rather than the
socket (or pipe), or I could maintain a buffer, rather than reading
from the pipe a line at a time. Is there a Right Way to do this? Maybe
some way of signalling to the child process when the parent has
finished?

Regards

Jeff

#!/usr/bin/perl

use warnings;
use strict;
use Socket;
use Gtk2 -init;
use Glib qw(TRUE FALSE);             # To get TRUE and FALSE
use FileHandle;
use POSIX;

# Create the windows
my $window = Gtk2::Window->new('toplevel');
my $box = Gtk2::VBox->new;
my $pbar = Gtk2::ProgressBar->new;
my $buttonQuit = Gtk2::Button->new('Quit');
my $buttonStart = Gtk2::Button->new('Start');

$window->add ($box);
$box->add ($pbar);
$box->add($buttonQuit);
$box->add($buttonStart);

my %helperTag;

# We should also link this to the destroy message on the main window,
# this is just quick and dirty
$buttonQuit->signal_connect(clicked => \&on_quit_clicked);
$buttonStart->signal_connect(clicked => \&start_process);
$window->show_all;
Gtk2->main;


# Process the exit of the child. If you were doing something useful,
# you might keep things like information about what data needs
# to be reloaded when a child process exits.

sub sig_child {
  my $pid = wait;
  if ($pid >= 0) {
  delete $helperTag{$pid};
 }
}

$SIG{CHLD} = \&sig_child;

sub start_process {
  my $pid;

 my ($reader, $writer);
  $reader = FileHandle->new;
  $writer = FileHandle->new;
  socketpair($reader, $writer,  AF_UNIX, SOCK_STREAM, PF_UNSPEC);

  $pid = fork();

  if ($pid) {
  # We're still in the parent, set up to watch the streams:

  shutdown($writer, 0);
  my $line;
  $helperTag{$pid} = Glib::IO->add_watch($reader->fileno(), ['in', 'hup'], sub {
   my ($fileno, $condition) = @_;

   if ($condition & 'in') { # bit field operation. >= would also work
    my $line = <$reader>;
    if ($line =~ /(\d*\.?\d*)(.*)/) {
     my $fraction=$1;
     my $text=$2;
     $pbar->set_fraction($fraction);
     $pbar->set_text($text);
print "reading $text\n";
     sleep(2);
    }
   }

# Can't have elsif here because of the possibility that both in and hup are set.
# Only allow the hup if sure an empty buffer has been read.
   if (($condition & 'hup') and (! defined($line) or $line eq '')) { #
bit field operation. >= would also work
    return FALSE;  # uninstall
   }
   return TRUE;  # continue without uninstalling
  });
 }
 else {
     # We're in the child. Do whatever processes we need to. We *must*
     # exit this process with POSIX::_exit(...), because exit() would
     # "clean up" open file handles, including our display connection,
     # and merely returning from this subroutine in a separate process
     # would *really* confuse things.

  shutdown($reader, 1);
  $pid = getpid();
  my $n = 4;
  for (my $i = 0; $i <= $n; $i++) {
   sleep(1);
print "writing $i of $n\n";
   $writer->write($i/$n."Running $i of $n\n");
   $writer->flush;
  }
  POSIX::_exit(0);
 }
}


# We should clean up after ourselves so that we don't
# leave dead processes flying around.
sub on_quit_clicked {
    # 15 = SIGTERM
  kill 15, $_ foreach (keys %helperTag);
 Gtk2->main_quit;
}



[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]