Calling clean up code in mod_perl environment - perl

Some quote to pick from practical mod_perl
"Usually, a single process serves many requests before it exits, so END blocks cannot be used if they are expected to do something at the end of each request's processing."
So, in my a.cgi script :
my $flag = 1;
END {
# Value for $flag is undefined, if this script is run under mod_perl.
# END block code only executed when process to handle a.cgi exit.
# I wish to execute some code, just before process to handle a.cgi exit.
if ($flag) {
# clean up code.
}
}
The book recommences $r->register_cleanup(sub { #cleanup } );
However,
How I can obtain $r in a.cgi script?
Can the subroutine access the my scope flag variable?
Is this $r->register_cleanup shall be placed at a.cgi script? I only want the cleanup code to be executed for a.cgi script. Not the rest.

my $r = Apache->request;
Yes, but see http://modperlbook.org/html/6-2-Exposing-Apache-Registry-Secrets.html and the next couple of pages, regarding scoping of local variables and functions.
Yes, only register the function if you want it to run.

If I understand this correctly, you have a script you want to run both under mod_perl and as a plain CGI and it sounds like you are using Apache::Registry to do this.
You have cleanup code that you want run only when you are running as CGI script.
You need to detect whether or not you are running under mod_perl. That's fairly easy. The simplest way is to check your environment:
unless ($ENV{MOD_PERL})
{
#... cleanup code here.
}
You only to register a cleanup handler if you want something to run when your script terminates under Apache::Registry.
If you do want that, you should place your cleanup code into a sub and call that sub from your check in the CGI:
unless ($ENV{MOD_PERL})
{
cleanup_sub();
}
and from your cleanup handler:
my $r = Apache->request;
$r->register_cleanup(sub { cleanup_sub() } );

Related

Perl's BEGIN blocks in app.psgi

I understand that the BEGIN is executed before the main program. The questions are:
what is the main program when talking about an PGSI application - or better
when will be executed the BEGIN block in an PGSI app?
It is different for plackup or Starman and like?
What about the middlewares - when have multiple BEGIN blocks?
Example app.psgi:
use Modern::Perl;
use YAML;
use Plack::Builder;
use CGI::Emulate::PSGI;
our($cfg);
BEGIN {
$cfg = YAML::LoadFile("my.config");
}
#old really __BIG__ cgi application - what uses many BEGIN blocks too...
my $app1 = CGI::Emulate::PSGI->handler(sub {
use My::CgiApp1;
My::CgiApp1::executer->run();
});
my $app2 = sub { ... };
builder {
mount "/path1" => $app1;
mount "/" => $app2;
}
In what order will be executed the multiple BEGIN blocks what are defined in My::CgiApp1 and my app.pgsi?
From the above PSGI application's point of view what is the main difference using:
BEGIN {
$cfg = YAML::LoadFile("my.config");
}
or an simple
$cfg = YAML::LoadFile("my.config");
BEGIN blocks are executed during the compilation phase immediately the end of the block is seen by the compiler.
That means each BEGIN block is executed only once, before the main run starts, and the blocks are executed in the order the compiler sees them.
Remember that a use statement is essentially require in a hidden BEGIN block, so in your case the compiler will process the main program, executing the YAML::LoadFile as soon as the closing brace of its BEGIN block is seen. Then it will continue compiling the program until use My::CgiApp1, when it will suspend processing the main program and start to compile My/CgiApp1.pm.
Perl will now execute any BEGIN blocks it finds in this file as they are encountered, and similarly suspend processing in the case of any further use statements.
As soon as the module specified in any use statement has finished compilation, processing will continue in the original file with next line of code.
All of this happens before My::CgiApp1::executer->run is executed, which is an ordinary statement and so is performed at run time.

POE complains that POE::Kernel's run method was never called when I fork

This is my code:
if ($DAEMON) {
my $pid = fork();
if (not defined $pid) {
print "Unable to start daemon.\n";
exit(1);
}
elsif ($pid == 0) {
open STDOUT, '>', '/dev/null';
open STDERR, '>', '/dev/null';
_create_sessions($self, $settings);
$poe_kernel->run;
}
else { print "Script forked to background with PID $pid\n"; }
}
else {
_create_sessions($self, $settings);
$poe_kernel->run;
}
When $DAEMON = 1, it complains that POE::Kernel's run() method was never called, but as you can see in the above code, I did that already. The script works perfectly fine when in daemon mode, but I can't get rid of that warning or understand why it says that. I also tried calling $poe_kernel->has_forked() and that didn't make a difference either.
I'm out of ideas. Any suggestions?
Updated to add: Maybe I wasn't clear enough. The code below creates the session and runs the kernel.
_create_sessions($self, $settings);
$poe_kernel->run;
It works perfectly fine. It's only when the same code is run inside a fork'd child so I can send the script to the background, that it says POE::Kernel's run method wasn't called. The script does go into the background and works like it should which means the kernel is indeed running. I'm only looking to get rid of that annoying warning.
ysth is right. The warning happens because POE::Session instances are created in the parent process but they haven't been given an opportunity to run.
% perl -wle 'use POE; POE::Session->create(inline_states=>{_start => sub {}})'
40023: Sessions were started, but POE::Kernel's run() method was never
40023: called to execute them. This usually happens because an error
40023: occurred before POE::Kernel->run() could be called. Please fix
40023: any errors above this notice, and be sure that POE::Kernel->run()
40023: is called. See documentation for POE::Kernel's run() method for
40023: another way to disable this warning.
In the above example, 40023 is the process ID where the problem was detected.
It's similar to Perl's warning about exiting with active threads:
% perl -wle 'use threads; threads->create(sub { sleep 3600 }); '
Perl exited with active threads:
1 running and unjoined
0 finished and unjoined
0 running and detached
While your code snippet shows sessions are created and run in the child process, I suspect sessions are created before or afterward. The parent process doesn't exit in your snippet, so there's no telling where execution goes afterward?
You should also call POE::Kernel->has_forked() in the child process. I can't tell whether that's happening in your code snippet.
The correct solution is to move all session instantiation into the child process when daemonizing. A passable workaround is to call POE::Kernel->run() just after using POE::Kernel and before any sessions are actually created. run() will return immediately because no sessions exist, but the call satisfies the condition you're being warned about. It's a way of saying "yes, yes, but I know what I'm doing".
From the doc, POE::Kernel's run is normally called as a class method; what is $poe_kernel?
Somewhere, you seem to be starting a session but don't end up calling POE::Kernel->run();
Update: since the message you see is output with warn, and you are throwing away STDERR in the child, I'm guessing it is the parent giving the warning. Something you are doing (in the code you don't show that loads POE and sets $poe_kernel?) is in fact creating a session, apparently unintentionally.
Try to reduce your code to a short, yet runnable example and you will either find the problem yourself or enable others to help you find it.

How to ignore some subroutine calls in NYTProf reporting

I'm trying to profile a Perl script, but CORE::sleep gobble all the space (and time) of my report.
How can i tell NYTProf to ignore sleep calls ?
Assuming we have the following script :
sub BrandNewSubroutine {
sleep 10;
print "Odelay\n";
}
BrandNewSubroutine();
I want to get rid of the following line of the report :
Exclusive Time;Inclusive Time;Subroutine
10.0s;10.0s;main::::CORE:sleepmain::CORE:sleep
(opcode)
Edit: Using DB::disable_profile() and DB::enable_profile() won't do the trick, as it add sleep time to BrandNewSubroutine Inclusive time.
Thanks in advance.
I'd suggest either wrapping the calls to sleep (possibly by use of method mentioned in perlsub) with DB::disable_profile() and DB::enable_profile() calls (RUN-TIME CONTROL OF PROFILING in NYTProf documentation), or post processing the report to remove the offending calls.
CORE::accept is already ignored in the way you'd like CORE::sleep to be, so the mechanism is already in place. See this code in NYTProf.xs:
/* XXX make configurable eg for wait(), and maybe even subs like FCGI::Accept
* so perhaps use $hide_sub_calls->{$package}{$subname} to make it general.
* Then the logic would have to move out of this block.
*/
if (OP_ACCEPT == op_type)
subr_entry->hide_subr_call_time = 1;
So with a little hacking (OP_SLEEP==op_type || OP_ACCEPT == op_type) you'd be able to ignore CORE::sleep in the same way.
I'd accept a patch to enable that as an option.

Perl script is getting killed during sleep()

I have a quite simple perl script, that in one function does the following:
if ( legato_is_up() ) {
write_log("INFO: Legato is up and running. Continue the installation.");
$wait_minutes = $WAITPERIOD + 1;
$legato_up = 1;
}
else {
my $towait = $WAITPERIOD - $wait_minutes;
write_log("INFO: Legato is not up yet. Waiting for another $towait minutes...");
sleep 30;
$wait_minutes = $wait_minutes + 0.5;
}
For some reason, sometimes (like 1 in 3 runs) the script gets killed. I don't know who's responsible for the kill, I just know it happens during the "sleep" call.
Can anyone give me a hint here? After script is killed, it's job is not done, which is a big problem.
Without knowing what else is running on your system, it's anybody's guess. You could add a signal handler, but all that it would tell you is which signal it was (and when), but not who sent it:
foreach my $signal (qw(INT PIPE HUP))
{
my $old_handler = $SIG{$signal};
$SIG{$signal} = sub {
print time, ": ", $signal, " received!\n";
$old_handler->(#_) if $old_handler;
};
}
You also may want to consider adding a WARN and DIE handler, if you are not logging output from stderr.
Under, at least Linux, you can see who sent a signal (if its an external process that used kill(2)) by looking at the siginfo struct (particularly si_pid) passed to a signal handler. I don't know how to see that from Perl however - but in your case you could strace (or similar on non-Linux platforms) your script and see it that way. e.g. strace -p <pid of your perl script>. You should see something like:
--- SIGTERM {si_signo=SIGTERM, si_code=SI_USER, si_pid=89165, si_uid=1000} ---
just before your untimely death.
(a few years late for the OP I know...)

Why are my shared variables getting cleared out between PerlChildInitHandler and PerlResponseHandler in mod_perl?

I am trying to load a configuration file into a hash during my PerlChildInitHandler and then access the values from PerlResponseHandler. However, even though the process number is the same, it seems that variables changed during the child_init() call revert back to their default values when handler() gets called.
The basic scenario is:
package StartupLog;
# the variable I'm testing
my $sticky = 0;
sub child_init {
$sticky = 1;
return 0;
}
sub handler {
warn __PACKAGE__ . " sticky = $sticky\n"; ### always says "0" but should say "1"
return 0;
}
1;
This was never answered, so eventually I moved on to using the PerlPostConfigHandler, which seemed to work acceptably. I can only assume it's something about the forking that happens in the PerlChildInitiHandler but, sorry to say, I gave up. Hope this helps someone in the future.
Generally, if you want to load something at childinit time, and access it in the response phase, you'd stuff it into a package global (like $My::variable = 'lols'). I've never tried to do it the way you are here. Did you try using our instead of my maybe?.