piping from external program not working..

[Syed Imran <imran s4-technology com>]

Hi all..

I have taken muppet's earlier posting and _very slightly_ modified it.
Basically, it reads an external program's output and displays it in a
scrolled window containing a textview.

It shows only the first line of output produced by the external program.
I am having difficulty locating the problem. I've added the code to this
mail.

Regards,
Imran

Here is the program (pipe.pl)::

==========pipe.pl==========
#!/usr/bin/perl -w

use strict;
use Glib 1.040, qw(TRUE FALSE);
use Gtk2 -init;
use IO::File;

my @worklist = ();

# <boilerplate type="window with a scrolling textview and a button">

# creating the main window
my $window = Gtk2::Window->new;
$window->signal_connect (delete_event => sub {exit});
$window->set_default_size (400, 300);

# add vbox to contain the SW and button
my $vbox = Gtk2::VBox->new;
$window->add ($vbox);

# SW container and textview inside it
my $scroller = Gtk2::ScrolledWindow->new;
$vbox->add ($scroller);
my $textview = Gtk2::TextView->new;
my $buffer = $textview->get_buffer;
$buffer->create_mark ('end', $buffer->get_end_iter, FALSE);
$buffer->signal_connect (insert_text => sub {
        $textview->scroll_to_mark ($buffer->get_mark ('end'),
                                   0.0, TRUE, 0, 0.5);
});
$scroller->add ($textview);

# GO button
my $button = Gtk2::Button->new ('go');
$button->signal_connect (clicked => \&button_handler);
$vbox->pack_start ($button, FALSE, FALSE, 0);

# show window and start the gtk main loop
$window->show_all;
Gtk2->main;
exit;

# </boilerplate>


sub button_handler {
        # add stuff to the work list, and start processing it.
#       @worklist = qw(three two one);
        @worklist = qw(one);
        kick_off_job ();
        # at this point, the processing is happening in the child,
        # and we just return to the main loop.
}

# this is called "kick off job" because we start the processing
# and return while the processing is going.
sub kick_off_job {
        unless (@worklist) {
                # the worklist is empty, so we have no more work to do.
                my $buffer = $textview->get_buffer;
                $buffer->insert ($buffer->get_end_iter,
                                 'list is empty!');
                # re-enable the button, so we can start over.
                $button->set_sensitive (TRUE);
                return;
        }

        $buffer->insert( $buffer->get_end_iter, 'list _not_ empty!!' );

        # if we're still here, we have stuff in the work list.
        # make sure the button is disabled, so we don't get more
        # stuff put on the queue.  (this isn't entirely necessary,
        # but you may want it this way.)
        $button->set_sensitive (FALSE);

        # let's process the next item.
        my $foo = shift @worklist;

        # we use IO::File to get a unique file handle.  this is very
        # important if we're handling more than one job at a time
        # (which this code does not do, but you may want to allow that
        # if you are on a multiprocessor system, where you can actually
        # run processes simultaneously to improve throughput).
        my $fh = new IO::File;

        # fork a copy of ourselves, and read the child's stdout.
        my $pid = $fh->open ("./test.pl|");
        die "can't fork: $!\n" unless defined $pid;

#       if ($pid == 0) {
#               # in child.  pretend to do some work, printing out
#               # status lines as we go.
#               warn "starting!\n"; # will show up on stderr
#               print "Starting $foo...\n";  # to be eaten by parent.
#               for (0..9) {
#                       print "$_\n";
#                       select undef, undef, undef, 0.5;
#               }
#               warn "Done!\n";
#               print "Finished $foo!\n";
#               # important!  do not continue to run or Very Bad Things
#               # can and will happen!
#               exit;
#
#       }

        if( $pid != 0 ) {
                # in parent.  install an io watch for this stream and
                # return immediately to the main caller, who will return
                # immediately to the event loop.  the callback will be
                # invoked whenever something interesting happens.
                Glib::IO->add_watch (fileno $fh, [qw/in hup err/],
                                     \&watch_callback, $fh);
        }
}


sub watch_callback {
        my ($fd, $condition, $fh) = @_;

        my $testbuf = $textview->get_buffer;
        $testbuf->insert( $buffer->get_end_iter, "reached here!!\n" );

        if ($condition >= 'in') {

                $testbuf->insert( $buffer->get_end_iter, "Input!!\n" );
                # there's data available for reading.  we have no
                # guarantee that all the data is there, just that
                # some is there.  however, we know that the child
                # will be writing full lines, so we'll assume that
                # we have lines and will just use <>.
                # my $data = scalar <$fh>;
                my $data = <$fh>;

                if (defined $data) {
                        # do something useful with the text.
                        my $buffer = $textview->get_buffer;
                        $buffer->insert ($buffer->get_end_iter, $data);
                }
        }

        $testbuf->insert( $buffer->get_end_iter, "reached here??\n" );
        $testbuf = undef;

        if ($condition >= 'hup' or $condition >= 'err') {
                # End Of File, Hang UP, or ERRor.  that means
                # we're finished.
                $fh->close;
                $fh = undef;
        }

        if ($fh) {
                # the file handle is still open, so return TRUE to
                # stay installed and be called again.
                return TRUE;
        } else {
                # we're finished with this job.  start another one,
                # if there are any, and uninstall ourselves.  if there's
                # more in the queue, kick_off_job() will install a new
                # watch for the new file handle.
                kick_off_job ();
                return FALSE;
        }
}
==========EOF:pipe.pl============

And this is my test.pl::

==========test.pl===========
#!/usr/bin/perl

use strict;

my $disk = '/dev/sda';
my $var = `/sbin/fdisk -l $disk`;

$| = 1;
print "This is test.pl :p\n";
print "this is another line of text which is supposed to test
pipe.pl\n";
print "$var";
=============EOF:test.pl========