broken pipe

[bpmedley 4321 tv]

Hi,

I'm having some trouble getting one of my gtk perl programs to run.  More
specifically, I'm having trouble when I try to fork() and use Gtk at the
same time.  My main goal is to construct an app that does gui work in the
parent and extra work in the child.  However, I'm getting the "Broken
pipe" error when I try and use Gtk after forking.

Interestingly, I noticed that the program works if I "init Gtk" *after*
doing the fork.  Yet it seems to me that it should work both times.  Does
anyone know why this behavior might happen?

Below is an example run.  Please run the attached code and let me know how
it works for you.  Thanks for your time, any help is appreaciated.

$ ./gtk_fork.pl -at_start -fork
Calling at start
Child Pid 21323 just read this: `Parent Pid 21322 is sending this'
Parent Pid 21322 just read this: `Child Pid 21323 is sending this'
got here
Broken pipe
$
$ ./gtk_fork.pl -at_start
Calling at start
got here
got there
$
$ ./gtk_fork.pl -at_end -fork
Child Pid 21326 just read this: `Parent Pid 21325 is sending this'
Parent Pid 21325 just read this: `Child Pid 21326 is sending this'
Calling at end
got here
got there
$
$ ./gtk_fork.pl -at_end
Calling at end
got here
got there

-- 
~'`^`'~=-.,__,.-=~'`^`'~=-.,__,.-=~'`^`'~=-., \|/  (___)  \|/ _,.-=~'`^`
                          Brian Medley         @~./'O o`\.~@
"Knowledge is Power" brian medley verizon net /__( \___/ )__\  *PPPFFBT!*
  -- Francis Bacon                               `\__`U_/'
 _,.-=~'`^`'~=-.,__,.-=~'`^`'~=-.,__,.-=~'`^`'~= <____|'  ^^`'~=-.,__,.-=
~`'^`'~=-.,__,.-=~'`^`'~=-.,__,.-=~'`^`'~=-.,__,.-==--^'~=-.,__,.-=~'`^`

#!/usr/bin/perl

use strict;
use warnings;

use Gtk;
use Socket;
use IO::Handle;
use Getopt::Long;

MAIN:
{
    my $window;
    my $button;
    my $pid;
    my %opts;
    
    my $at_start = 2;
    my $at_end   = 2;
    my $fork     = 2;
    GetOptions("at_start!" => \$at_start, "at_end!" => \$at_end, "fork!" => \$fork);
    
    if (2 == $at_start && 2 == $at_end) {
        print "You must select start or end\n";
        exit;
    }
    
    if (1 == $at_start) {
        print "Calling at start\n";
        set_locale Gtk;
        init Gtk;
    }

    if (1 == $fork) {
        socketpair(CHILD, PARENT, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC)
            or  die "socketpair: $!";

        CHILD->autoflush(1);
        PARENT->autoflush(1);

        my $line;
        if ($pid = fork) {
            close PARENT;

            print CHILD "Parent Pid $$ is sending this\n";
            chomp($line = <CHILD>);
            print "Parent Pid $$ just read this: `$line'\n";

            close CHILD;
            waitpid($pid,0);

        } else {
            die "cannot fork: $!" unless defined $pid;
            close CHILD;

            chomp($line = <PARENT>);
            print "Child Pid $$ just read this: `$line'\n";
            print PARENT "Child Pid $$ is sending this\n";

            close PARENT;
            exit;
        }
    }

    if (1 == $at_end) {
        print "Calling at end\n";
        set_locale Gtk;
        init Gtk;
    }

    print("got here\n");
    $window = new Gtk::Window("toplevel");
    print("got there\n");
    $window->signal_connect("destroy", sub { Gtk->exit(0) });
    $window->set_title("testing");
    $button = new Gtk::Button("Quit");
    $button->signal_connect("clicked", sub { Gtk->exit(0) });
    $window->add($button);
    $window->show_all;

    main Gtk;
}