Slash Boxes
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

TeeJay (2309)

  (email not shown publicly)

Working in Truro
Graduate with BSc (Hons) in Computer Systems and Networks
pm :,,
lug : Devon & Cornwall LUG
irc : TeeJay
skype : hashbangperl
livejournal : hashbangperl []
flickr :hashbangperl []

Journal of TeeJay (2309)

Wednesday March 15, 2006
01:18 PM

Funky perl in my scheduler

[ #29001 ]
I've pretty much completed the scheduler I have been developing - I just need to polish the web gui and integrate log4perl properly.

Anyway - one of the things it does is run commands either as perl via do() or via system().

It captures stderr/stdout through copying the current filehandles for each, and reopening them to files, reopening the copied filehandles again after running a command. That bit is fairly simple, but allows me to slurp in the stderr output after running the command or if the whole process running the command dies unexpectedly. In a scheduler with dozens of jobs to run, many of them in development this is incredibly useful:


    open(OLD_STDERR,">&STDERR") or warn "Failed to save STDERR";
    open(STDERR,">$stderr_filename") or warn "Failed to redirect STDERR";
    open(OLD_STDOUT,">&STDOUT") or warn "Failed to save STDOUT";
    open(STDOUT,">$stdout_filename") or warn "Failed to redirect STDOUT";

    print "$$\n"; # don't want an empty file
    warn "$$\n"; # don't want an empty file

   # do stuff ...

    open(STDOUT,">&OLD_STDOUT") or warn "Failed to restore STDOUT";
    open(STDERR,">&OLD_STDERR") or warn "Failed to restore STDERR";


The tricky bit this morning was handling scripts that 'exit' when executed within do. I want to capture that exit and continue, but any other exits should happen normally.

The only solution that actually worked was to copy  a glob of CORE::GLOBAL::exit to somewhere, set the glob to sub that warns/logs the exit, with time and pid, before continuing, and then copy the original exit glob back :

    eval {
    *real_exit = *CORE::GLOBAL::exit;
    *CORE::GLOBAL::exit = sub { warn localtime() ." pid : $$ attempted to exit! caller : ", join(', ',caller()),"\n"; };
    $ok = do "$filename";
    $error = "couldn't parse $filename: $@" if $@;
    $error = "couldn't do $filename: $!"    unless defined $ok;
    $error = "couldn't run $filename"       unless $ok;
    *CORE::GLOBAL::exit = *real_exit;

Getting it working was helped immensely by Nik and Davorg on following Nik's talk at the last tech meet where he demonstrated how to over-ride stuff in a script that is being run.
The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
More | Login | Reply
Loading... please wait.
  • First of all, thanks for sharing -- that's useful stuff. But have you considered local() instead of copying something and then copying it back at the end?

    eval {
        local *CORE::GLOBAL::exit = sub {
            warn localtime() ." pid : $$ attempted to exit! caller : ", join(', ',caller()),"\n";
        $ok = do "$filename";
        $error = "couldn't parse $filename: $@" if $@;
        $error = "couldn't do $filename: $!"    unless defined

    • yes I tried it - despite having being in an anon block inside an eval it didn't descope for some reason - possibly I fluffed it, but exits ended up getting caught in unexpected places elsewhere in the program.

      @JAPH = qw(Hacker Perl Another Just);
      print reverse @JAPH;
      • Dom's code won't work because core subroutines can only be overridden at compile-time. Also you don't need to store a copy of *CORE::GLOBAL::exit as it can always be found in CORE::exit (although you can't take a reference to it so just use a wee closure e.g *CORE::GLOBAL::exit = sub { CORE::exit $_[0] };).

        broquaint out

  • What you are doing sounds quite a bit like what IPC::Run3 does.

    Is it missing something, or does it do something in a way that doesn't work for you? Have you heard of it?
    • It kind of evolved, I'd be tempted to replace it with IPC::Run but only if it others exactly the same stuff without adding complexity.

      Although, to be honest - it's working very nicely now

      @JAPH = qw(Hacker Perl Another Just);
      print reverse @JAPH;