Re: forked process exiting before output read

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");


binmode $fh, ':utf8';

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

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

Thanks for any pointers



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);

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);

# 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;
     Gtk2->main_iteration while Gtk2->events_pending;

# 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++) {
   send($writer, $i/$n."Running \x{2013} $i of $n\n", 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);

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