How can I set a code that must execute before a Perl script stops?
In here how to run piece of code just before the exit of perl script I read about the END subroutine, but it only executes if the script ends normally. However, I want the code to be executed also if, for example, user aborts the program by ^C.
Trap the termination signals and re-route them so something, simplest would be:
$SIG{TERM} = $SIG{INT} = $SIG{QUIT} = $SIG{HUP} = sub { die; };
Related
I have a long-running program that used File::Temp::tempdir to create a temporary file and sometimes interrupted it via ^C.
The following program prints the name of the temporary directory it creates and the name of a file in it.
#!/usr/bin/env perl
use strict;
use warnings;
use File::Temp qw[tempdir];
my $dir = tempdir(CLEANUP => 1);
print "$dir\n";
print "$dir/temp.txt\n";
`touch $dir/temp.txt`;
exit;
On OS X, this creates a directory inside /var/folders
If the last line is exit; or die;, then the folder will get cleaned up and the temporary file inside it will get deleted.
However, if we replace the last line with sleep 20; and then interrupt the perl program via ^C, the temporary directory remains.
% perl maketemp.pl
/var/folders/dr/cg4fl5m11vg3jfxny3ldfplc0000gn/T/ycilyLSFs6
/var/folders/dr/cg4fl5m11vg3jfxny3ldfplc0000gn/T/ycilyLSFs6/temp.txt
^C
% stat /var/folders/dr/cg4fl5m11vg3jfxny3ldfplc0000gn/T/ycilyLSFs6/temp.txt
16777220 6589054 -rw-r--r-- 1 <name> staff 0 0 "Aug 1 20:46:27 2016" "Aug 1 20:46:27 2016" "Aug 1 20:46:27 2016" "Aug 1 20:46:27 2016" 4096 0 0
/var/folders/dr/cg4fl5m11vg3jfxny3ldfplc0000gn/T/ycilyLSFs6/temp.txt
%
using a signal handler that just calls exit; does clean up the directory. E.g.
#!/usr/bin/env perl
use strict;
use warnings;
use File::Temp qw[tempdir];
$SIG{INT} = sub { exit; };
my $dir = tempdir(CLEANUP => 1);
print "$dir\n";
print "$dir/temp.txt\n";
`touch $dir/temp.txt`;
sleep 20;
As does using a "trivial" signal handler
#!/usr/bin/env perl
use strict;
use warnings;
use File::Temp qw[tempdir];
$SIG{INT} = sub { };
my $dir = tempdir(CLEANUP => 1);
print "$dir\n";
print "$dir/temp.txt\n";
`touch $dir/temp.txt`;
sleep 20;
I tried looking through the source code (https://github.com/Perl-Toolchain-Gang/File-Temp/blob/master/lib/File/Temp.pm) to determine how tempdir is registering a cleanup action
Here's the exit handler installation
https://github.com/Perl-Toolchain-Gang/File-Temp/blob/master/lib/File/Temp.pm#L1716
which calls _deferred_unlink
https://github.com/Perl-Toolchain-Gang/File-Temp/blob/master/lib/File/Temp.pm#L948
which modified the global hashes %dirs_to_unlink and %files_to_unlink, but uses the pid $$ as a key for some reason (probably in case the Perl interpreter forks? Not sure why that's necessary though since removing a directory seems like it would be an idempotent operation.)
The actual logic to clean up the files is here, in the END block.
https://github.com/Perl-Toolchain-Gang/File-Temp/blob/master/lib/File/Temp.pm#L878
A quick experiment shows that END blocks are indeed run when perl has exited normally or abnormally.
sleep 20;
END {
print "5\n";
}
# does not print 5 when interrupted
And are run here
$SIG{INT} = sub {};
sleep 20;
END {
print "5\n";
}
# does print 5 when interrupted
So ... why does the END block get skipped after a SIGINT unless there's a signal handler, even one that seems like it should do nothing?
By default, SIGINT kills the process[1]. By kill, I mean the process is immediately terminated by the kernel. The process doesn't get to perform any cleanup.
By setting a handler for SIGINT, you override this behaviour. Instead of killing the process, the signal handler is called. It might not do anything, but its very existence prevented the process from being killed. In this situation, the program won't exit as a result of the signal unless it chooses to exit (by calling die or exit in the handler. If it does, it would get a chance to cleanup as normal.
Note that if a signal for which a handler was defined comes in during a system call, the system call exits with error EINTR in order to allow the program to safely handle the signal. This is why sleep returns as soon as SIGINT is received.
If instead you had used $SIG{INT} = 'IGNORE';, the signal would have been completely ignored. Any systems calls in progress won't be interrupted.
On my system, man 1 kill lists the default actions of signals.
Your signal handler $SIG{INT} = sub {} isn't doing nothing, it is trapping the signal and preventing the program from exiting.
But to answer your original question, END blocks, as perlmod says:
is executed as late as possible, that is, after perl has finished running the program and just before the interpreter is being exited, even if it is exiting as a result of a die() function. (But not if it's morphing into another program via exec, or being blown out of the water by a signal--you have to trap that yourself (if you can).)
That is, a fatal signal, if not trapped, circumvents Perl's global destruction and does not call END blocks.
I have a Perl Expect script which handles file transfers. The script works fine except that it exits before the file transfer finishes. I don't want to rely on sleep() because the amount of time needed can vary.
Is there someway for expect to wait for my command to finish, before continuing?
my $exp = Expect->spawn("perl ./fileTransfer.pl $url")
or die "Cannot spawn program: $!\n";
#Enter credentials
$exp->send($username);
sleep(1);
$exp->send($password);
sleep(1);
#This only executes for a bit, before the program exits:
$exp->send($getFiles);
$exp->soft_close();
exit;
This was solved by simply using $exp->expect(undef); instead of $exp->soft_close();
I also took #Mark Setchell 's advice and now 'expect' specific prompts, this way I can easily do multiple 'sends' without fear of one executing before the prior one finishes.
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;
}
When you use exec() in Perl:
Note that exec will not call your END blocks, nor will it invoke DESTROY methods on your objects.
How do I force perl to call END blocks anyway? Can I do something like END(); exec($0) or whatever?
I really am trying to make the program end its current instance and start a brand new instance of itself, and am too lazy to do this correctly (using cron or putting the entire program in an infinite loop). However, my END subroutines cleanup temp files and other important things, so I need them to run between executions.
Unhelpful links to code:
https://github.com/barrycarter/bcapps/blob/master/bc-metar-db.pl
https://github.com/barrycarter/bcapps/blob/master/bc-voronoi-temperature.pl
https://github.com/barrycarter/bcapps/blob/master/bc-delaunay-temperature.pl
So you're trying to execute a program within your script? exec probably isn't what you want then. exec behaves like the C exec: what gets called replaces your current process; to keep going, you'd have to do something like a fork to preserve your current process while executing another.
But good news! That all exists in the system builtin.
Does exactly the same thing as exec LIST , except that a fork is done first and the parent process waits for the child process to exit.
Here's what it looks like:
use 5.012; # or use 5.012 or newer
use warnings;
... # some part of my program
system($my_command, $arg1, $arg2); # forks, execs, returns.
END {
# still gets called because you never left the script.
}
If you absolutely must use an exec, you must call your cleanup routine automatically. To understand more about END, see perldoc perlmod for full details. The short of it: END is one of several types of blocks of code that gets execucted at a particular stage in the execution of the script. They are NOT subroutines. However, you can execute any code you want in those subroutines. So you can do:
sub cleanup { ... } # your cleanup code
sub do_exec {
cleanup();
exec( ... );
}
END {
cleanup();
}
and then you know your cleanup code will be executed at either script exit OR when you do your exec.
To answer the narrow question of how to invoke your END blocks at arbitrary times, you can use the B::end_av method with B::SV::object_2svref to get the code references to your END blocks.
sub invoke_end_blocks_before_exec {
use B;
my #ENDS = B::end_av->ARRAY;
foreach my $END (#ENDS) {
$END->object_2svref->();
}
}
END { print "END BLOCK 1\n" }
END { print "END BLOCK 2\n" }
...
invoke_end_blocks_before_exec();
exec("echo leave this program and never come back");
Output:
END BLOCK 2
END BLOCK 1
leave this program and never come back
I would usually prefer something less magical, though. Why not a structure like
sub cleanup { ... }
END { &cleanup }
if (need_to_exec()) {
cleanup(); # same thing END was going to do anyway
exec( ... );
}
?
Fork and exec
It'll leave you with a new pid, but you could do a fork/exec:
my $pid = fork();
defined $pid or die "fork failed";
exit if $pid; # parent immediately exits, calling END blocks.
exec($0) or die "exec failed"; # child immediately execs, will not call END blocks (but parent did, so OK)
This strikes me as far less fragile than mucking with internals or trying to make sure your exec is in the final END block.
Wrap your program
Also, it is trivial to just wrap your Perl program in a shell (or Perl) script that looks something like this:
#!/bin/sh
while sleep 5m; do
perl your-program.pl
done
or
#!/usr/bin/perl
while (1) {
system("perl your-program.pl");
sleep(5*60);
}
Can you put your call to exec in at the end of the (final) END block? Where your current call to exec is, set a flag, then exit. At the end of the END block, check the flag, and if it's true, call exec there. This way, you can exit your script without restarting, if necessary, and still have the END blocks execute.
That said, I'd recommend not implementing this type of process-level tail recursion.
I'm running a command line application from within the perl script(using system()) that sometimes doesn't return, to be precise it throws exception which requires the user input to abort the application. This script is used for automated testing of the application I'm running using the system() command. Since, it is a part of automated testing, sytem() command has to return if the exception occurs and consider the test to be fail.
I want to write a piece of code that runs this application and if exception occurs it has to continue with the script considering the this test to be failed.
One way to do this is to run the application for certain period of time and if the system call doesn't return in that period of time we should terminate the system() and continue with the script.
(How can I terminate a system command with alarm in Perl?)
code for achieving this:
my #output;
eval {
local $SIG{ALRM} = sub { die "Timeout\n" };
alarm 60;
return = system("testapp.exe");
alarm 0;
};
if ($#) {
print "Test Failed";
} else {
#compare the returned value with expected
}
but this code doesn't work on windows i did some research on this and found out that SIG doesn't work for windows(book programming Perl).
could some one suggest how could I achieve this in windows?
I would recommend looking at the Win32::Process module. It allows you to start a process, wait on it for some variable amount of time, and even kill it if necessary. Based on the example the documentation provides, it looks quite easy:
use Win32::Process;
use Win32;
sub ErrorReport{
print Win32::FormatMessage( Win32::GetLastError() );
}
Win32::Process::Create($ProcessObj,
"C:\\path\\to\\testapp.exe",
"",
0,
NORMAL_PRIORITY_CLASS,
".")|| die ErrorReport();
if($ProcessObj->Wait(60000)) # Timeout is in milliseconds
{
# Wait succeeded (process completed within the timeout value)
}
else
{
# Timeout expired. $! is set to WAIT_FAILED in this case
}
You could also sleep for the appropriate number of seconds and use the kill method in this module. I'm not exactly sure if the NORMAL_PRIORITY_CLASS creation flag is the one you want to use; the documentation for this module is pretty bad. I see some examples using the DETACHED_PROCESS flag. You'll have to play around with that part to see what works.
See Proc::Background, it abstracts the code for both win32 and linux, the function is timeout_system( $seconds, $command, $arg, $arg, $arg )