Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Redirecting STDOUT from internal function with 5.6.1 restrictions

by mgc (Novice)
on Oct 12, 2004 at 16:53 UTC ( #398587=perlquestion: print w/ replies, xml ) Need Help??
mgc has asked for the wisdom of the Perl Monks concerning the following question:

I have combed the archives of this site looking for help with redirecting STDOUT from the Test::ok function temporarily. Unfortunately, all the answers so far work fine in 5.8 but not on 5.6 or require adding a new file to application distribution.

My first attempt was as follows:

# Works with 5.8 only! sub ok_test_wrapper($@) { my ($desc,@params) = @_; my ($stdout); open (OLDOUT, '>&STDOUT') || die "dup() of STDOUT failed: $!"; close STDOUT or die "close STDOUT: $!"; open STDOUT, '>', \$stdout or die "redirect STDOUT: $!"; Test::ok(@params); close STDOUT or die "close STDOUT: $!"; open (STDOUT, '>&OLDOUT') || die "reopen STDOUT: $!"; close OLDOUT or die "close OLDOUT: $!"; chomp($stdout); print "$stdout - $desc\n"; return; } sub ok($;$$) { ok_test_wrapper("$_[[1]]",$_[[0]]); }

Unfortunately, the manpage for open in 5.6 does not allow the use of references in the same way as 5.8. It creates a file by the name 'HASH(0x3859383)' or the like.

p>Using Tie::Handle requires creating another file which on our system requires going through the whole design process again. The preferred solution is a modification to the file this code resides in.

The only option I came up with, which is a hack, is to write/read a temp file...yuck...

# Hack sub ok_test_wrapper($@) { my ($desc,@params) = @_; my ($stdout) = "./foo3.$$"; open (OLDOUT, '>&STDOUT') || die "dup() of STDOUT failed: $!"; close STDOUT or die "close STDOUT: $!"; open STDOUT, '>', $stdout or die "redirect STDOUT: $!"; select STDOUT; $| = 1; Test::ok(@params); close STDOUT or die "close STDOUT: $!"; open (STDOUT, '>&OLDOUT') || die "reopen STDOUT: $!"; close OLDOUT or die "close OLDOUT: $!"; open FH, "<$stdout" or die "reading file failed: $!"; my $tmp = <FH>; close(FH); unlink($stdout); chomp($tmp); print "$tmp - $desc\n"; return; }

Any other ideas?

mgc

Comment on Redirecting STDOUT from internal function with 5.6.1 restrictions
Select or Download Code
Re: Redirecting STDOUT from internal function with 5.6.1 restrictions
by borisz (Canon) on Oct 12, 2004 at 17:03 UTC
      Thanks for the idea, however, the module IO::String(y)
      apparently is not part of the core modules in 5.6.1 and
      the sysadmins in their infinate wisdom decided not to 
      load that one :<
      
      mgc
      
Re: Redirecting STDOUT from internal function with 5.6.1 restrictions
by tilly (Archbishop) on Oct 12, 2004 at 17:21 UTC
    Random advice. Unless you really need them, do not use prototypes.

    As threads like Are prototypes evil? and When to use Prototypes? point out, they don't do what you want them to, and do what you don't. Unfortunately the Tom Christiansen article that everyone points to has been removed from www.perl.com (why I do not know). However you can still find it at FMTYEWTK about Prototypes.

    Update I'd only half-written this when I hit submit. I finished off the dangling sentences.

Re: Redirecting STDOUT from internal function with 5.6.1 restrictions
by Jenda (Abbot) on Oct 12, 2004 at 18:22 UTC

    Looks to me like the docs of Test.pm need to be improved. If you look into the source you can see that the module makes a reference to the STDOUT as soon as it's used and then prints to that reference.

    Anyway it seems that all you need to do is this:

    open $Test::TESTOUT, '>', $stdout;
    to redirect the output and
    close $Test::TESTOUT; $Test::TESTOUT=*STDOUT{IO};
    to switch it back.

    Jenda
    We'd like to help you learn to help yourself
    Look around you, all you see are sympathetic eyes
    Stroll around the grounds until you feel at home
       -- P. Simon in Mrs. Robinson

      For a minute there I thought you were on to something, but
      alas it turned out to be an incorrect assumption. Here is
      how I see it...
      
      In the code Test module Test.pm 'makes a copy' of the STDOUT filehandle
      
      
      $TESTOUT = *STDOUT{IO};
      This has the same effect as below:
      open( TESTOUT, ">&STDOUT" ) || die "dup failed";
      In either case Perl comes back complaining that: "A file or directory in the path name does not exist at ...". Which means that the last parameter in the 5.6.1 version of open must point to a string with a path/filename. mgc

        OK then. I should have tested my suggestions. Anyway this does seem to work fine in Perl 5.6.1:

        use FileHandle; use Test; plan(tests => 3); ok("first"); { local $Test::TESTOUT; open $Test::TESTOUT, '>', "$ENV{TEMP}/zkTestRedirect.txt"; ok("second"); } ok("third");

        Jenda
        We'd like to help you learn to help yourself
        Look around you, all you see are sympathetic eyes
        Stroll around the grounds until you feel at home
           -- P. Simon in Mrs. Robinson

Re: Redirecting STDOUT from internal function with 5.6.1 restrictions
by tmoertel (Chaplain) on Oct 12, 2004 at 21:59 UTC
    (Update: Wrapped the redirecting code into a convenient, reusable function.)

    The following code shows one way of doing what you want in 5.6.1, all wrapped into a tidy function. It does use a temporary file, but the file is cleaned up automatically, and File::Temp uses a random file name to protect against certain kinds of file-based attacks.

    use File::Temp qw( tempfile ); sub capture_output { my $target_fh = shift; my $temp_fh = tempfile(); my $temp_fd = fileno $temp_fh; local *SAVED; local *TARGET = $target_fh; open SAVED, ">&TARGET" or die "can't remember target"; open TARGET, ">&=$temp_fd" or die "can't redirect target"; my $saved_fh = *SAVED; return sub { seek $temp_fh, 0, 0 or die "can't seek"; # rewind my $captured_output = do { local $/; <$temp_fh> }; close $temp_fh or die "can't close temp file handle"; local (*SAVED, *TARGET) = ($saved_fh, $target_fh); open TARGET, ">&SAVED" or die "can't restore target"; close SAVED or die "can't close SAVED"; return $captured_output; } }
    With this code in place, capturing output from any filehandle becomes easy:
    print STDERR "before redirection\n"; my $recorder = capture_output(*STDERR); # start print STDERR "during redirection\n"; my $saved_output = $recorder->(); # stop print STDERR "after redirection\n"; print "Saved output = $saved_output";
    The output is what you would expect (tested on Perl v5.6.1 built for i386-linux):
    before redirection after redirection Saved output = during redirection

    Sidebar: I don't know why you think a file-based solution is a hack. Unless you have a really good reason not to use a temp file, you'll probably find it to be the most practical, general-purpose solution.

    Because you want to capture what is written to STDERR, you must preserve typical file-descriptor semantics. Using a temp file gives you this behavior for free.

    Yes, you could try to use a tied filehandle, but the 5.6.1 perltie docs say that tied-filehandle support is only "partially implemented." More importantly, you'll be hosed if what you're testing ends up writing to the stderr file descriptor directly, bypassing your filehandle. This can easily happen if your code uses external libraries, which just about all code does implicitly via the standard C libraries that Perl links against.

    Given that the temp-file solution will work in all situations and has the advantage of being drop-dead simple, my recommendation is to use it. Only if it proves inadequate in actual practice should you worry about more complicated solutions.

    Cheers,
    Tom

      Did I say STDERR? Sorry I meant STDOUT.
      I ended up going with the temp file idea...thanks.
        Did I say STDERR? Sorry I meant STDOUT.

        No need to be sorry. You said STDOUT – rather clearly and several times at that, I see, now that I re-read your orignal post. I'm just a goofball and somehow read it as STDERR. Each and every time. (Note to self: The correct order is: espresso first, post second.)

        Thank you for being gracious about my error and not pointing out how big of a dope I am. Luckily, I didn't hardcode STDERR into my example code, and so I don't look like a complete idiot.

        Anyway, I'm glad that everything worked out, despite mine eyes having deceived me.   :)

        Cheers,
        Tom

Re: Redirecting STDOUT from internal function with 5.6.1 restrictions
by diotalevi (Canon) on Oct 12, 2004 at 23:49 UTC

    If you were using Test::More, this would be easy and documented. The output handle is set by the internal Test::Builder object which itself has the methods ->output( $fh ), ->failure_output( $fh ), and ->todo_output( $fh ) to set the various filehandles.

    Here is an example from one of my scripts which shows test output being captured.

    use Test::More; use vars qw( $TEST_OUTPUT ); main( @ARGV ); exit 0; sub main { intialize( @_ ); ok( ... ); print $TEST_OUTPUT; 1; } sub initialize { $| = 1; open my $fh, ">", \ $TEST_OUTPUT or die; my $b = Test::More->builder; $b->output( $fh ); $b->failure_output( $fh ); $b->todo_output( $fh ); 1; }
      Thanks, but the reason I posted this was because I don't have Test::More available to me. Thanks.

        Its available from CPAN. http://search.cpan.org/dist/Test-Simple/

        If silly office politics prevent you from installing CPAN modules you can copy the module straight into your test directory and have your tests do "use lib 't/lib'". See http://search.cpan.org/src/MSCHWERN/ExtUtils-MakeMaker-6.23/t/lib/Test/ for an example.

        -- Michael G Schwern

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://398587]
Approved by Jenda
Front-paged by diotalevi
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (3)
As of 2014-07-31 02:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (244 votes), past polls