Re: forked process exiting before output read

["Jeffrey Ratcliffe" <jeffrey ratcliffe gmail com>]

On 31/01/2008, Jeffrey Ratcliffe <jeffrey ratcliffe gmail com> wrote:
> This seems to break for utf8 messages, with:
>
> *** unhandled exception in callback:
> ***   Wide character in send
>
> I've tried creating the filehandles with
>
> $fh = FileHandle->new(":utf8");
>
> or
>
> binmode $fh, ':utf8';

Here's a demo trying to send/recv a utf8 character. It crashes with:

$ ../ForkDemo8.pl
writing 0 of 4
*** unhandled exception in callback:
***   Wide character in send at ../ForkDemo8.pl line 96.
***  ignoring at ../ForkDemo8.pl line 30.

Thanks for any pointers

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(":utf8");
  $writer = FileHandle->new(":utf8");
  socketpair($reader, $writer,  AF_UNIX, SOCK_DGRAM, 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
    recv($reader, $line, 1000, 0);
    if (defined($line) and $line =~ /(\d*\.?\d*)(.*)/) {
     my $fraction=$1;
     my $text=$2;
     $pbar->set_fraction($fraction);
     $pbar->set_text($text);
     Gtk2->main_iteration while Gtk2->events_pending;
     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);
   send($writer, $i/$n."Running \x{2013} $i of $n\n", 0);
  }
  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;
}