Problem with perl signal INT - perl

I have the following perl code on windows activestate perl 5.8
$SIG{INT}=\&clean;
...
sub clean {
print 'cleaning...';
...
...
exit 0;
}
but when i try to close my program by Ctrl^c it didn't enter the sub clean at all could someone help why did i miss something ?

It seems that Windows doesn't provide signals as in Unix.
From man perlwin32:
Signal handling may not behave as on Unix platforms (where it doesn't
exactly "behave", either :). For instance, calling "die()" or "exit()"
from signal handlers will cause an exception, since most implementations
of "signal()" on Win32 are severely crippled. Thus, signals may
work only for simple things like setting a flag variable in the handler.
Using signals under this port should currently be considered
unsupported.

I'd say no. I can't see anything wrong with what you're doing. I wrote a test program that actually runs:
#!/usr/bin/perl
use strict;
use warnings;
$SIG{INT}=\&clean;
sub clean {
print 'caught';
}
sleep 10;
Tested on Linux, this works as expected, but I don't have AS perl handy to try it. Try it yourself on your machine.
Also, print to STDERR to ensure it's not something very odd going on with print buffering.

I found that the script given by #ijw (modified to be what it is below) does not work under Active State Perl version v5.10.1:
This is perl, v5.10.1 built for MSWin32-x86-multi-thread
(with 2 registered patches, see perl -V for more detail)
My modification below adds the autoflush calls (as otherwise the sleep
below would not show the print statement output at all while
sleeping):
#!/usr/bin/perl
use IO;
use strict;
use warnings;
# Set autoflushing on to stdout and stderr. Otherwise, system() call and stdout output does not show up in proper sequence,
# especially on Windows:
STDOUT->autoflush(1);
STDERR->autoflush(1);
$SIG{INT}=\&clean;
sub clean {
print "caught\n";
exit (0);
}
print "before sleep\n";
sleep 100;
print "after sleep and then exiting\n";
exit (0);
When I commented out the following lines in that script above:
$SIG{INT}=\&clean;
sub clean {
print "caught\n";
exit (0);
}
And then hitting CTRL-C during the sleep, the script does terminate and show this message:
Terminating on signal SIGINT(2)
Hence it must actually still be true (well, for ActiveState Perl v5.10.1) what man perlwin32 states:
... most implementations of "signal()" on Win32 are severely crippled. ...
For future reference:
perlmonks refers to the use of Win32::API to setup a call to the SetConsoleCtrlHandler Win32 function.
All about SetConsoleCtrlHandler.

Related

Run perl binary with autoflush enabled

My program runs perl as a process in potentially many places with different scripts which I have inherited and would prefer not to modify needlessly if I can avoid it.
The root problem I'm facing is that my program cannot consume standard output as the perl script is executing unless autoflush is enabled (otherwise it will just get every log message instantly after the perl script has finished).
Therefore, what I'd like to do is to run perl with autoflush enabled by command line argument if possible. Something like this would be ideal:
perl -e "$| = 1" -e "foo.pl"
But obviously that doesn't work.
There is a CPAN module called Devel::Autoflush that does exactly this. You would invoke it from the command line:
perl -MDevel::Autoflush your-script-name-here.pl
...and it sets autoflush mode. Looking at the source code it's pretty easy to see how it works. You could just implement it yourself if you live in a world where CPAN modules are not permitted. Just create a module as follows:
package AutoFlush;
my $orig_fh = select STDOUT;
$| = 1;
select STDERR;
$| = 1;
select $orig_fh;
1;
And then from the command line invoke it just as I described above:
perl -MAutoFlush your-script-name-here.pl
This little example module is almost identical to how Devel::Autoflush does it.
Update: And as TLP correctly points out, the following would be even simpler syntax:
package AutoFlush
STDOUT->autoflush(1);
STDERR->autoflush(1);
1;
This may pull in more code, since the syntax relies on the implicit on-demand upgrading of the STDOUT and STDERR filehandles to IO::Handle objects, but when coding for clarity and programmer efficiency first, this is an obvious improvement.

How do I prevent my Perl script from echoing what is typed into the terminal while it's running?

How do I prevent my Perl script from echoing what is typed into the terminal while it's running?
I tried messing around with system("stty -echo"); and then running system("stty echo"); at the end, but it still displays what I type once the script ends. I've been playing around with this test script.
#!/usr/bin/perl
use strict;
use warnings;
system("stty -echo");
for (1..15) {
print "$_\n";
sleep(1);
}
system("stty echo");
This could mess up the terminal if the second system called is never reached (maybe use an END block, but that's not guaranteed to work either). This would also be Unix only and my script is run on Windows too.
I also found the module Term::Readkey, but I would prefer not bringing in any other modules.
I also tried just closing STDIN but that didn't work either.
What makes this problem easier is that I don't need to read STDIN at all during execution, I can just ignore it.
I don't have much experience with this type of problem, hopefully it's easier than I'm making it out to be. Thanks!
edit: I'm on Perl 5.10 if that makes a difference.
Take a look at Term::ReadKey:
use strict;
use warnings;
use Term::ReadKey;
ReadMode ( 'noecho' );
my $password = <STDIN>;
ReadMode ( 'normal' ); #Back to your regularly scheduled program
Unfortunately, it's not a standard module. And, I've had some problems with this on Windows.

Perl Term::ReadLine::Gnu Signal Handling Difficulties

I'm using Term::ReadLine::Gnu and have run into a problem with signal handling. Given the script below and a TERM signal sent to the script, the handler for the TERM signal is not triggered until after the enter key is pressed. Using Term::ReadLine:Perl this does not occur.
I've read that Term::ReadLine::Gnu has its own internal signal handlers, but frankly I'm at a loss as to how to work with them.
I've reviewed http://search.cpan.org/~hayashi/Term-ReadLine-Gnu-1.20/Gnu.pm#Term::ReadLine::Gnu_Variables tried setting the rl_catch_signals variable to 0, but that didn't help. Ideally, I'd like to work with the Gnu signal handlers, but I'll settle for disabling them too.
To be absolutely specific, I need the TERM handler to trigger after the signal is received instead of waiting for the enter key to be pressed.
Any help or advice is certainly appreciated!
#!/usr/bin/perl
use strict;
use warnings;
use Term::ReadLine;
$SIG{TERM} = sub { print "I got a TERM\n"; exit; };
my $term = Term::ReadLine->new('Term1');
$term->ornaments(0);
my $prompt = 'cmd> ';
while ( defined (my $cmd = $term->readline($prompt)) ) {
$term->addhistory($cmd) if $cmd !~ /\S||\n/;
chomp($cmd);
if ($cmd =~ /^help$/) {
print "Help Menu\n";
}
else {
print "Nothing\n";
}
}
This is due to perl's default paranoid handling of signals - behind the scenes, perl blocks SIGTERM before starting the readline call and restores it when it's finished. See Deferred Signals in perlipc for the details.
Term::ReadLine::Perl uses perl's IO, which knows about these issues and deals with them, so you don't see this bug with it. Term::ReadLine::Gnu uses the C library, which doesn't, so you do.
You can work around this with one of two methods:
set the environment variable PERL_SIGNALS to unsafe before running the script, as in:
bash$ PERL_SIGNALS=unsafe perl readline-test.pl
Note, BEGIN { $ENV{PERL_SIGNALS} = "unsafe"; } isn't enough, it needs to be set before perl itself starts.
Use POSIX signal functions:
#~ $SIG{TERM} = sub { print "I got a TERM\n"; exit; };
use POSIX;
sigaction SIGTERM, new POSIX::SigAction sub { print "I got a TERM\n"; exit; };
Both the above seem to work in Linux; can't speak for Windows or other unices. Also, both of the above come with risks - see perlipc for the details.

In Perl is there a way to restart the program currently running from within itself?

I am running a program in Perl that at one point evaluates data in an if statement called from within a subroutine, e.g.
sub check_good {
if (!good) {
# exit this subroutine
# restart program
}
else {
# keep going
}
} # end sub
The problem I have is with exiting and restarting. I know that I can just use exit 0; to exit straight out, but obviously this is not correct if I want to go back to the beginning. I tried calling the subroutine which essentially starts the program, but of course once it has run it will go back to this point again.
I thought about putting it in a while loop, but this would mean putting the whole file in the loop and it would be very impractical.
I don't actually know whether this is possible, so any input would be great.
If you have not changed #ARGV, or you keep a copy of it, you could possibly do something like exec($^X, $0, #ARGV).
$^X and $0 (or $EXECUTABLE_NAME and $PROGRAM_NAME, see Brian's comment below) are the current perl interpreter and current perl script, respectively.
An alternative would be to always have two processes: A supervisor and a worker.
Refactor all your logic into a subroutine called run(or main or whatever). Whn your real logic detect that it needs to restart it should exit with a predefined non-zero exit code (like 1 for example).
Then your main script and supervisor would look like this:
if (my $worker = fork) {
# child process
run(#ARGV);
exit 0;
}
# supervisor process
waitpid $worker;
my $status = ($? >> 8);
if ($status == 1) { ... restart .. }
exit $status; # propagate exit code...
In the simple scenario where you just want to restart once, this might be a bit overkill. But if you at any point need to be able to handle other error scenarios this method might be preferable.
For example if the exit code is 255, this indicates that the main script called die(). In this case you might want to implement some decision procedure wether to restart the script, ignore the error, or escalate the issue.
There are quite a few modules on CPAN implementing such supervisors. Proc::Launcher is one of them and the manual page includes a extensive discussion of related works. (I have never used Proc::Launcher, it is mainly due to this discussion I'm linking to it)
There's nothing to stop you calling system on yourself. Something like this (clearly in need of a tidy), where I pass in a command-line argument to prevent the code calling itself forever.
#!/usr/bin/perl
use strict;
use warnings;
print "Starting...\n";
sleep 5;
if (! #ARGV) {
print "Start myself again...\n";
system("./sleep.pl secondgo");
print "...and die now\n";
exit;
} elsif ((#ARGV) && $ARGV[0] eq "secondgo") {
print "Just going to die straightaway this time\n";
exit;
}

Circumstances under which die() does not exit a Perl script?

I'm debugging a really weird problem with a long-running Perl script.
The problem is that the script does not exit on die() as expected. Instead the script just hangs without returning.
I've not defined any error handlers myself so I would assume that die() would lead to an immediate termination of the script.
This is the basic structure of the script and the modules used:
#!/usr/bin/perl
use strict;
use utf8;
use warnings;
use DBI; # with MySQL driver ("dbi:mysql:database=...")
use Geo::IP;
use POSIX;
use URI::Escape;
open(COMMAND, 'command_line |');
while (<COMMAND>) {
#
# .. stuff that can go wrong ..
#
die("I'm expecting the script to terminate here. It doesn't.") if ($gone_wrong);
}
close(COMMAND);
What could be the explanation to this behaviour? Is any of the modules used known to set up error handlers that could explain the script hanging on die()?
Well, END blocks and object destructors are still called after a die. If one of those hangs (or does something that takes a long time), the script won't exit immediately. But that should happen after printing the message from die (unless STDERR is buffered so you don't see the message immediately).
You mention DBI, so you probably have a database handle whose destructor is being called. (I'm not sure that's the problem, though.)