perl tk fileevent fail on the second event-CodePudding

This simple excerpt, run on Perl 5.16.3, at open forks a sub-process which send data to the main one.

#!/usr/bin/perl
use Tk;
my $mainWindow = MainWindow->new();
$mainWindow->Button(-text => "Run", -command => \&run)->pack();
MainLoop;
my $fh;
sub receiver()
{
    print "$_" while <$fh>;
    print "End\n";
    close $fh;
}
sub run()
{
    print "run\n";
    my $pid = open $fh, '-|';
    die "Failed to start\n" unless defined $pid;
    print "pid=$pid\n";
    exec "echo Hello" unless $pid;
    $mainWindow->fileevent($fh, 'readable', \&receiver);
}

It works as expected the first time only, at the second click on the button the open produce:

Tk::Error: Can't locate object method "OPEN" via package "Tk::Event::IO" at fe.pl line 16. Tk callback for .button Tk::ANON at /usr/lib64/perl5/vendor_perl/Tk.pm line 251 Tk::Button::butUp at /usr/lib64/perl5/vendor_perl/Tk/Button.pm line 175 (command bound to event)

I'm struggling to understand the reason, without success. Any idea?

CodePudding user response：

Tk::Error: Can't locate object method "OPEN" via package "Tk::Event::IO"

Seems like you need to delete the fileevent handler each time you are finished with the receiver, or else Tk will try to call the callback again later (with the same filehandle that you just closed in the receiver) but then the file handle is no longer valid.

The following works for me:

use strict;
use warnings;
use Tk;

my $mainWindow = MainWindow->new();
$mainWindow->Button(-text => "Run", -command => \&run)->pack();
MainLoop;

sub run()
{
    my $fh;
    my $receiver = sub {
        print "$_" while <$fh>;
        print "End\n";
        close $fh;
        # delete handler since $fh is no longer used
        $mainWindow->fileevent($fh, "readable", "");
    };

    print "run\n";
    my $pid = open $fh, '-|';
    die "Failed to start\n" unless defined $pid;
    print "pid=$pid\n";
    exec "echo Hello" unless $pid;
    $mainWindow->fileevent($fh, 'readable', $receiver);
}

CodePudding user response：

#!/usr/bin/perl
use Tk;
my $mainWindow = MainWindow->new();
$mainWindow->Button(-text => "Run", -command => \&run)->pack();
MainLoop;
sub run()
{
    my $fh;
    my $pid;
    $SIG{CHLD} = sub
    {
        my $kid = waitpid(-1, WNOHANG);
        print "$kid exited with $? ${^CHILD_ERROR_NATIVE}\n"
    };
    my $receiver = sub
    {
        print "$_" while <$fh>;
        print "End\n";
        close $fh;
        # delete handler since $fh is no longer used
        $mainWindow->fileevent($fh, 'readable', '');
    };
    print "run\n";
    $pid = open $fh, '-|';
    die "Failed to start\n" unless defined $pid;
    print "pid=$pid\n";
    exec "echo Hello" unless $pid;
    $mainWindow->fileevent($fh, 'readable', $receiver);
}