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

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.)

Related

Using filehandles in Perl to alter actively running code

I've been learning about filehandles in Perl, and I was curious to see if there's a way to alter the source code of a program as it's running. For example, I created a script named "dynamic.pl" which contained the following:
use strict;
use warnings;
open(my $append, ">>", "dynamic.pl");
print $append "print \"It works!!\\n\";\n";
This program adds the line
print "It works!!\n";
to the end of it's own source file, and I hoped that once that line was added, it would then execute and output "It works!!"
Well, it does correctly append the line to the source file, but it doesn't execute it then and there.
So I assume therefore that when perl executes a program that it loads it to memory and runs it from there, but my question is, is there a way to access this loaded version of the program so you can have a program that can alter itself as you run it?
The missing piece you need is eval EXPR. This compiles, "evaluates", any string as code.
my $string = q[print "Hello, world!";];
eval $string;
This string can come from any source, including a filehandle.
It also doesn't have to be a single statement. If you want to modify how a program runs, you can replace its subroutines.
use strict;
use warnings;
use v5.10;
sub speak { return "Woof!"; }
say speak();
eval q[sub speak { return "Meow!"; }];
say speak();
You'll get a Subroutine speak redefined warning from that. It can be supressed with no warnings "redefine".
{
# The block is so this "no warnings" only affects
# the eval and not the entire program.
no warnings "redefine";
eval q[sub speak { return "Shazoo!"; }];
}
say speak();
Obviously this is a major security hole. There is many, many, many things to consider here, too long for an answer, and I strongly recommend you not do this and find a better solution to whatever problem you're trying to solve this way.
One way to mitigate the potential for damage is to use the Safe module. This is like eval but limits what built in functions are available. It is by no means a panacea for the security issues.
With a warning about all kinds of issues, you can reload modules.
There are packages for that, for example, Module::Reload. Then you can write code that you intend to change in a module, change the source at runtime, and have it reloaded.
By hand you would delete that from %INC and then require, like
# ... change source code in the module ...
delete $INC{'ModuleWithCodeThatChages.pm'};
require ModuleWithCodeThatChanges;
The only reason I can think of for doing this is experimentation and play. Otherwise, there are all kinds of concerns with doing something like this, and whatever your goal may be there are other ways to accomplish it.
Note The question does specify a filehandle. However, I don't see that to be really related to what I see to be the heart of the question, of modifying code at runtime.
The source file isn't used after it's been compiled.
You could just eval it.
use strict;
use warnings;
my $code = <<'__EOS__'
print "It works!!\n";
__EOS__
open(my $append_fh, ">>", "dynamic.pl")
or die($!);
print($append_fh $code);
eval("$code; 1")
or die($#);
There's almost definitely a better way to achieve your end goal here. BUT, you could recursively make exec() or system() calls -- latter if you need a return value. Be sure to setup some condition or the dominoes will keep falling. Again, you should rethink this, unless it's just practice of some sort, or maybe I don't get it!
Each call should execute the latest state of the file; also be sure to close the file before each call.
i.e.,
exec("dynamic.pl"); or
my retval;
retval = system("perl dynamic.pl");
Don't use eval ever.

Cleanup tmp dirs when hitting CTRL-C from perl -d debug session

For the temp directory I need in my script, I go with:
my $work_dir = File::Temp->newdir(TEMPLATE => "/tmp/work.$$.XXXX" ) or die "Cannot create tempdir directory $!";
My hope with newdir() is to get the promise of:
By default the directory is deleted when the object goes out of scope.
Only to learn that if I hit CTRL-C, $work_dir will NOT be removed.
So I added signals:
use sigtrap qw(handler signal_handler normal-signals);
and then I simply use (File::Path 'remove_tree');
sub signal_handler
{
remove_tree $work_dir;
}
This helps if I hit CTRL-C while my script runs...
However, it does NOT clean up while using the debugger, if I CTRL-C out of the debugger! If I quit out cleanly (with the q command) then it works/cleans fine, only if I CTRL-C out of the debug session, that's when $work_dir is not being removed.
Is it possible, in any way, to have the signal handler being called automatically even within a perl debug session ?
(or any other "proper" ways how to use/install signal handlers)
Your signal handler isn't doing what you think it does, because passing an object to remove_tree doesn't work:
use strict;
use warnings;
use 5.010;
use File::Path qw(remove_tree);
use File::Temp;
my $tmpdir = File::Temp->newdir(CLEANUP => 0);
remove_tree $tmpdir;
say "$tmpdir still exists" if -d $tmpdir;
Outputs:
/tmp/lTfotn79RD still exists
The call to remove_tree in your signal handler seems to work when run outside of the debugger, but it's actually not doing anything. (You can prove this to yourself by commenting out the call to remove_tree and re-running your script.) So why does the directory get removed?
If a signal handler doesn't exit or die, execution continues wherever it left off before the signal was caught. In your case, after the signal handler finishes, the program simply runs to completion. When the program terminates, any objects that are still in scope are cleaned up by calling their DESTROY methods. File::Temp->newdir returns a File::Temp::Dir object; this object's DESTROY method is what actually removes the directory from the filesystem (it uses rmtree under the hood).
This doesn't work when you interrupt the debugger; I'm not familiar with the debugger's internals, but I'm guessing it keeps references to objects so that DESTROY isn't called, even when you step off the end of the program. If you Ctrl+C again at this point, the object is never cleaned up, and neither is the temporary directory.
One way I found to work around this is to explicitly undef the object returned by File::Temp->newdir in your signal handler:
use strict;
use warnings;
use 5.010;
use File::Temp;
use sigtrap qw(handler cleanup normal-signals);
my $tmpdir = File::Temp->newdir;
sub cleanup {
my ($sig) = #_;
say "Caught signal SIG$sig";
undef $tmpdir;
exit 0;
}
This causes the DESTROY method to be called before the program exits, so you're not relying on the debugger to clean up. This seems like kind of a hack, though; why not just quit the debugger gracefully with q?
Note that you could also pass the stringified version of $tmpdir to remove_tree like this:
remove_tree "$tmpdir";
But I wouldn't recommend this, since the documentation strongly cautions against relying on file names:
For maximum security, endeavour always to avoid ever looking at, touching, or even imputing the existence of the filename. You do not know that that filename is connected to the same file as the handle you have, and attempts to check this can only trigger more race conditions. It's far more secure to use the filehandle alone and dispense with the filename altogether.
I like to use an END block. The any clean exit from the program, especially a 'quit' from the debugger will trigger the END block an, in my case, delete all my test data.
So put your clean up code in and END block have have you sig handler call exit() instead of remove_tree.
END {
remove_tree $work_dir;
}
sub signal_handler
{
exit();
}

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.

Problem with perl signal INT

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.

How do I run a Perl script from within a Perl script?

I've got a Perl script that needs to execute another Perl script. This second script can be executed directly on the command line, but I need to execute it from within my first program. I'll need to pass it a few parameters that would normally be passed in when it's run standalone (the first script runs periodically, and executes the second script under a certain set of system conditions).
Preliminary Google searches suggest using backticks or a system() call. Are there any other ways to run it? (I'm guessing yes, since it's Perl we're talking about :P ) Which method is preferred if I need to capture output from the invoked program (and, if possible, pipe that output as it executes to stdout as though the second program were invoked directly)?
(Edit: oh, now SO suggests some related questions. This one is close, but not exactly the same as what I'm asking. The second program will likely take an hour or more to run (lots of I/O), so I'm not sure a one-off invocation is the right fit for this.)
You can just do it.
{
local #ARGV = qw<param1 param2 param3>;
do '/home/buddy/myscript.pl';
}
Prevents the overhead of loading in another copy of perl.
The location of your current perl interpreter can be found in the special variable $^X. This is important if perl is not in your path, or if you have multiple perl versions available but which to make sure you're using the same one across the board.
When executing external commands, including other Perl programs, determining if they actually ran can be quite difficult. Inspecting $? can leave lasting mental scars, so I prefer to use IPC::System::Simple (available from the CPAN):
use strict;
use warnings;
use IPC::System::Simple qw(system capture);
# Run a command, wait until it finishes, and make sure it works.
# Output from this program goes directly to STDOUT, and it can take input
# from your STDIN if required.
system($^X, "yourscript.pl", #ARGS);
# Run a command, wait until it finishes, and make sure it works.
# The output of this command is captured into $results.
my $results = capture($^X, "yourscript.pl", #ARGS);
In both of the above examples any arguments you wish to pass to your external program go into #ARGS. The shell is also avoided in both of the above examples, which gives you a small speed advantage, and avoids any unwanted interactions involving shell meta-characters. The above code also expects your second program to return a zero exit value to indicate success; if that's not the case, you can specify an additional first argument of allowable exit values:
# Both of these commands allow an exit value of 0, 1 or 2 to be considered
# a successful execution of the command.
system( [0,1,2], $^X, "yourscript.pl", #ARGS );
# OR
capture( [0,1,2, $^X, "yourscript.pl", #ARGS );
If you have a long-running process and you want to process its data while it's being generated, then you're probably going to need a piped open, or one of the more heavyweight IPC modules from the CPAN.
Having said all that, any time you need to be calling another Perl program from Perl, you may wish to consider if using a module would be a better choice. Starting another program carries quite a few overheads, both in terms of start-up costs, and I/O costs for moving data between processes. It also significantly increases the difficulty of error handling. If you can turn your external program into a module, you may find it simplifies your overall design.
All the best,
Paul
I can think of a few ways to do this. You already mentioned the first two, so I won't go into detail on them.
backticks: $retVal = `perl somePerlScript.pl`;
system() call
eval
The eval can be accomplished by slurping the other file into a string (or a list of strings), then 'eval'ing the strings. Heres a sample:
#!/usr/bin/perl
open PERLFILE, "<somePerlScript.pl";
undef $/; # this allows me to slurp the file, ignoring newlines
my $program = <PERLFILE>;
eval $program;
4 . do: do 'somePerlScript.pl'
You already got good answers to your question, but there's always the posibility to take a different point of view: maybe you should consider refactoring the script that you want to run from the first script. Turn the functionality into a module. Use the module from the first and from the second script.
If you need to asynchronously call your external script -you just want to launch it and not wait for it to finish-, then :
# On Unix systems, either of these will execute and just carry-on
# You can't collect output that way
`myscript.pl &`;
system ('myscript.pl &');
# On Windows systems the equivalent would be
`start myscript.pl`;
system ('start myscript.pl');
# If you just want to execute another script and terminate the current one
exec ('myscript.pl');
Use backticks if you need to capture the output of the command.
Use system if you do not need to capture the output of the command.
TMTOWTDI: so there are other ways too, but those are the two easiest and most likely.
See the perlipc documentation for several options for interprocess communication.
If your first script merely sets up the environment for the second script, you may be looking for exec.
#!/usr/bin/perl
use strict;
open(OUTPUT, "date|") or die "Failed to create process: $!\n";
while (<OUTPUT>)
{
print;
}
close(OUTPUT);
print "Process exited with value " . ($? >> 8) . "\n";
This will start the process date and pipe the output of the command to the OUTPUT filehandle which you can process a line at a time. When the command is finished you can close the output filehandle and retrieve the return value of the process. Replace date with whatever you want.
I wanted to do something like this to offload non-subroutines into an external file to make editing easier. I actually made this into a subroutine. The advantage of this way is that those "my" variables in the external file get declared in the main namespace. If you use 'do' they apparently don't migrate to the main namespace. Note the presentation below doesn't include error handling
sub getcode($) {
my #list;
my $filename = shift;
open (INFILE, "< $filename");
#list = <INFILE>;
close (INFILE);
return \#list;
}
# and to use it:
my $codelist = [];
$codelist = getcode('sourcefile.pl');
eval join ("", #$codelist);