PerlTk - running a command-line program once again

Author

running a command-line program once again - how to interpret error msg

Will Parsons

2007-12-08, 7:06 pm

I've previously asked for and gotten help on running a command-line program
from a Perl/Tk application in a text window, both under Unix and Windows.
This is basically working now, but I have discovered a further problem
under Unix. The basic technique I'm using is:
-----------------------------
my ($Script_window, $Text);

sub run_script_in_window {
unless (Exists($Script_window)) {
$Script_window = new MainWindow;
$Text = $Script_window->Scrolled('ROText')
->pack(-fill => 'both', -expand => 1);
}

$| = 1;

open (PIPE, "-|", "perl $Script 2>&1") or die "Can't execute process.\n";

$Script_window->fileevent(\*PIPE,
readable => [\&read_pipe_data, \*PIPE, $Text]);
}

sub read_pipe_data {
my ($pipe, $text) = @_;
if (sysread($pipe, my $buffer, 1024) > 0) {
$text->insert('end', $buffer);
$text->see('end');
...
} else {
close $pipe;
}
}
-----------------------------

This works fine when I run it the first time, but if I try to re-execute
run_script_in_window, I get an error message:

Tk::Error: Can't locate object method "OPEN" via package "Tk::Event::IO" at
../excomdb line 978.
main::run_script_in_window at ./excomdb line 978
Tk callback for .#menu.#menu#database. #menu#database#update_database_from_exte
rnal_sources
Tk::__ANON__ at /usr/local/lib/perl5/site_perl/5.8.8/mach/Tk.pm line 247
Tk::Menu::Invoke at /usr/local/lib/perl5/site_perl/5.8.8/mach/Tk/Menu.pm line 531
<ButtonRelease>
(command bound to event)

Line 978 in the error message is the open (PIPE, ...) statement above.

What is this error message telling me?

- Will

zentara

2007-12-09, 7:10 pm

On 8 Dec 2007 19:01:58 GMT, Will Parsons <oudeis@nodomain.invalid>
wrote:

>This is basically working now, but I have discovered a further problem
>under Unix. The basic technique I'm using is:

>-----------------------------
>my ($Script_window, $Text);
>
>sub run_script_in_window {
> unless (Exists($Script_window)) {
> $Script_window = new MainWindow;
> $Text = $Script_window->Scrolled('ROText')
> ->pack(-fill => 'both', -expand => 1);
> }
>
> $| = 1;
>
> open (PIPE, "-|", "perl $Script 2>&1") or die "Can't execute process.\n";
>
> $Script_window->fileevent(\*PIPE,
> readable => [\&read_pipe_data, \*PIPE, $Text]);
>}
>
>sub read_pipe_data {
> my ($pipe, $text) = @_;
> if (sysread($pipe, my $buffer, 1024) > 0) {
> $text->insert('end', $buffer);
> $text->see('end');
> ...
> } else {
> close $pipe;
> }
>}
>-----------------------------
>
>This works fine when I run it the first time, but if I try to re-execute
>run_script_in_window, I get an error message:
>
>Tk::Error: Can't locate object method "OPEN" via package "Tk::Event::IO" at
>./excomdb line 978.
> main::run_script_in_window at ./excomdb line 978
> Tk callback for .#menu.#menu#database. #menu#database#update_database_from_exte
rnal_sources
> Tk::__ANON__ at /usr/local/lib/perl5/site_perl/5.8.8/mach/Tk.pm line 247
> Tk::Menu::Invoke at /usr/local/lib/perl5/site_perl/5.8.8/mach/Tk/Menu.pm line 531
> <ButtonRelease>
> (command bound to event)
>
>Line 978 in the error message is the open (PIPE, ...) statement above.
>
>What is this error message telling me?
>
>- Will

At the top you say running it under Unix gives the problem, but
it seems you should get that problem running under windows. It's
pretty much common knowledge that running fileevent on pipes
on a windows platform will not work. Usually, on Win32, it is
recomended to use IPC::Run (which uses sockets not pipes) or
Win32::Pipe.

But if the script runs Ok on Windows, but gives the error on Unix,
it's a weird problem. What version of windows are you using, that
allows fileevent on pipes?

zentara

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Will Parsons

2007-12-10, 7:05 pm

zentara wrote:
> On 8 Dec 2007 19:01:58 GMT, Will Parsons <oudeis@nodomain.invalid>
> wrote:
>
>
>
> At the top you say running it under Unix gives the problem, but
> it seems you should get that problem running under windows. It's
> pretty much common knowledge that running fileevent on pipes
> on a windows platform will not work. Usually, on Win32, it is
> recomended to use IPC::Run (which uses sockets not pipes) or
> Win32::Pipe.
>
> But if the script runs Ok on Windows, but gives the error on Unix,
> it's a weird problem. What version of windows are you using, that
> allows fileevent on pipes?

The code I am having trouble with is only run under Unix - I abandoned
this approach under Windows precisely because of the problems with pipes
and fileevent under Windows, and am using an alternate approach using
threads. I *don't* want to use the threads approach under Unix, because
a version of Perl that supports threads may not be available, and using
fileevent should work.

- Will

zentara

2007-12-11, 8:05 am

On 10 Dec 2007 16:24:46 GMT, Will Parsons <wbp@nodomain.invalid> wrote:

>zentara wrote:
[color=darkred]
[color=darkred]
>The code I am having trouble with is only run under Unix - I abandoned
>this approach under Windows precisely because of the problems with pipes
>and fileevent under Windows, and am using an alternate approach using
>threads. I *don't* want to use the threads approach under Unix, because
>a version of Perl that supports threads may not be available, and using
>fileevent should work.
>
>- Will
Ok,
The only thing I can think of is the syntax here, I'm not sure what the
"-|" does

open (PIPE, "-|", "perl $Script 2>&1") or
die "Can't execute process.\n";

Unless the -| does something special that you need, I would try the
following syntax

open (PINGTEST, "ping $host 2>&1 |") or die "can't fork: $!";
#or
#open (PINGTEST, "| ping $host 2>&1") or die "can't fork: $!";
$mw->fileevent(\*PINGTEST, 'readable', [\&fill_text_widget,$t]);

Are you trying to feed the stdin of your $Script? If so, you probably
will have trouble with your method. STDIN needs special treatment beyond
what normal pipes receive.

Otherwise, can you post a chopped down running script that shows the
problem?

zentara

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Will Parsons

2007-12-12, 7:06 pm

zentara wrote:
> On 10 Dec 2007 16:24:46 GMT, Will Parsons <wbp@nodomain.invalid> wrote:
>
>
>
> Ok,
> The only thing I can think of is the syntax here, I'm not sure what the
> "-|" does
>
> open (PIPE, "-|", "perl $Script 2>&1") or
> die "Can't execute process.\n";
>
> Unless the -| does something special that you need, I would try the
> following syntax
>
> open (PINGTEST, "ping $host 2>&1 |") or die "can't fork: $!";
>

I took the syntax from the perldoc description of open, but I tried
your suggestion (both syntax and using ping instead of my script) and
get the same result. I don't see how it can be syntax error since it
works fine when executed once - I only get the error when I try to
re-execute.

> Are you trying to feed the stdin of your $Script? If so, you probably
> will have trouble with your method. STDIN needs special treatment beyond
> what normal pipes receive.

No - the script does not read from STDIN.

> Otherwise, can you post a chopped down running script that shows the
> problem?

That will take some work - the script fairly complex. I was hoping
that some clue is given by the error message. I don't understand how
"open" function is getting transformed into the 'object method "OPEN"
via package "Tk::Event::IO"' of the error message.

- Will

zentara

2007-12-13, 7:07 pm

On 12 Dec 2007 18:04:00 GMT, Will Parsons <wbp@nodomain.invalid> wrote:

[color=darkred]
>
>That will take some work - the script fairly complex. I was hoping
>that some clue is given by the error message. I don't understand how
>"open" function is getting transformed into the 'object method "OPEN"
>via package "Tk::Event::IO"' of the error message.
>
>- Will

Hi, I fiddled around and was able to demonstrate your problem in a small
script, and find a fix. Kind of tricky.

The following script will fail with your error, on the second button
press. BUT, if you uncomment the line that clears out the fileevent,
it works. I guess something must be happening in the symbol table,
where the CHILD filehandle callback isn't being completely cleared out.
And a second run, causes it to look for it's previous pipe.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = new MainWindow;

my $t = $mw->Scrolled("Text",
-width => 80,
-height => 25, -wrap => 'none')->pack(-expand => 1);

$mw->Button(-text=>'test',
-command=> \&do_it)->pack();

MainLoop;

sub do_it{

open(CHILD,"ps auxww 2>&1 |") or die "Can't open: $!";
$mw->fileevent(\*CHILD, 'readable', [\&fill_text_widget,$t]);
}

sub fill_text_widget {
my($widget) = @_;
if (sysread(CHILD, my $buffer, 1024 ) > 0 ){

$widget->insert('end', $buffer);
$widget->yview('end');
}

else{

# ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
^
# uncomment the following line to fix the problem
# $mw->fileevent(\*CHILD, 'readable', '');

close CHILD}
}
__END__

So just add that fileevent clearout to your script.

zentara

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Will Parsons

2007-12-13, 7:07 pm

zentara wrote:
> Hi, I fiddled around and was able to demonstrate your problem in a small
> script, and find a fix. Kind of tricky.
>
> The following script will fail with your error, on the second button
> press. BUT, if you uncomment the line that clears out the fileevent,
> it works. I guess something must be happening in the symbol table,
> where the CHILD filehandle callback isn't being completely cleared out.
> And a second run, causes it to look for it's previous pipe.
>
> #!/usr/bin/perl
> use warnings;
> use strict;
> use Tk;
>
> my $mw = new MainWindow;
>
> my $t = $mw->Scrolled("Text",
> -width => 80,
> -height => 25, -wrap => 'none')->pack(-expand => 1);
>
>
> $mw->Button(-text=>'test',
> -command=> \&do_it)->pack();
>
> MainLoop;
>
> sub do_it{
>
> open(CHILD,"ps auxww 2>&1 |") or die "Can't open: $!";
> $mw->fileevent(\*CHILD, 'readable', [\&fill_text_widget,$t]);
> }
>
> sub fill_text_widget {
> my($widget) = @_;
> if (sysread(CHILD, my $buffer, 1024 ) > 0 ){
>
> $widget->insert('end', $buffer);
> $widget->yview('end');
> }
>
> else{
>
> # ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
^
> # uncomment the following line to fix the problem
> # $mw->fileevent(\*CHILD, 'readable', '');
>
> close CHILD}
> }
> __END__
>
>
> So just add that fileevent clearout to your script.

That does indeed solve the problem. I don't think I'd have ever figured
that one out from the error message, so thanks again!

- Will

zentara

2007-12-14, 8:04 am

On 13 Dec 2007 20:08:11 GMT, Will Parsons <oudeis@nodomain.invalid>

> zentara wrote:
> # ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
^

[color=darkred]
>That does indeed solve the problem. I don't think I'd have ever figured
>that one out from the error message, so thanks again!
>- Will

It's a tough , rarely encountered problem, I believe is related to a
thing called closures and the way static filehandles are retained in the
symbol table.

In modern, more Perlish code, they use variables for filehandles, and
the problem is avoided. The following code dosn't need the fileevent
clearout, and is probably is the preferred way to fix it. Static
filehandle names can cause problems.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = new MainWindow;

my $t = $mw->Scrolled("Text",
-width => 80,
-height => 25, -wrap => 'none')->pack(-expand => 1);

$mw->Button(-text=>'test',
-command=> \&do_it)->pack();

MainLoop;

sub do_it{
my $fh;
open($fh,"ps auxww 2>&1 |") or die "Can't open: $!";
$mw->fileevent($fh, 'readable', [\&fill_text_widget,$t,$fh]);
}

sub fill_text_widget {
my($widget, $filehandle) = @_;
if (sysread($filehandle, my $buffer, 1024 ) > 0 ){

$widget->insert('end', $buffer);
$widget->yview('end');
}

else{

# don't need the following line to fix the problem
# with a variable filehandle
# $mw->fileevent($filehandle, 'readable', '');

close $filehandle}
}
__END__

I learned something too..... so it was worthwhile for me also. :-)

zentara

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html

Sponsored Links