BUU has asked for the wisdom of the Perl Monks concerning the following question:

Heres the basic situation. I have a function call. When I run it, it prints stuff to stdout. I wish to have this in a variable instead. Here is the code that prints to stdout:
use Perl; my $p = Perl->new( ARGV => [ "-le", "print 'hello world'"] ); $p->run;


In case you are unfamiliar with the module in question, it is Perl.pm in the bundle named "PerlInterp-0.03" on cpan.

Yes, in case you are curious, I have tried reopening stdout to a scalar reference, using io::capture::stdout, tying stdout, etc. No luck so far.

Update: In case anyone cares, none of the solutions presented actually work. (Except for possibly the first one that Anonymous Monk suggested, as I can't get open FOO,"-|"; to do anything useful on win32)

Update2: The reason none of these solutions work, is Perl.pm gets it's own filedescriptors from the kernel (or something like that), so all the perl magic you want to do doesn't affect the file descriptors Perl.pm eventually gets.

Replies are listed 'Best First'.
Re: Challenge: Capturing stdout from a function call.
by hlen (Beadle) on Oct 21, 2004 at 13:11 UTC
    This usually works:
    #!/usr/bin/perl use strict; use warnings; use IO::Scalar; my $data; { local *STDOUT; tie *STDOUT, 'IO::Scalar', \$data; &print_something(); } print "\$data: $data"; sub print_something() { print "something\n"; }
    Output:
    $data: something
Re: Challenge: Capturing stdout from a function call.
by Anonymous Monk on Oct 21, 2004 at 09:22 UTC
    #!/usr/bin/perl use strict; use warnings; sub function { print "Hello, world\n"; } my $kid; my $pid = open ($kid, "-|"); die "Failed to fork: $!" unless defined $pid; unless ($pid) { # Child. function; exit; } undef $/; my $scalar = <$kid>; print "Got: $scalar"; __END__ Got: Hello, world

    See also the perlipc manual page.

Re: Challenge: Capturing stdout from a function call.
by PodMaster (Abbot) on Oct 21, 2004 at 09:36 UTC
    It doesn't look like you can without hacking Perl. Try
    close STDOUT; # comment out to see the difference, try opening STD +OUT to something else use Perl; my $p = Perl->new( ARGV => [ '-le', 'print(1)for(1..22)'] ); $p->run;
    Looks like you'll have to settle for an intermediary file (open STDOUT, '>', ...).

    MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
    I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
    ** The third rule of perl club is a statement of fact: pod is sexy.

Re: Challenge: Capturing stdout from a function call.
by johnnywang (Priest) on Oct 21, 2004 at 18:22 UTC
      That looks like a really elegant solution. When I tried it on my system, I ended up with a file named SCALAR(0x17651f0) containing "from foo". What am I missing?
        perl5.8 probably.
Re: Challenge: Capturing stdout from a function call.
by eclark (Scribe) on Oct 22, 2004 at 18:17 UTC
    use strict; use warnings; use Perl; my $p = Perl->new; my $data = $p->eval(q{ do{ use IO::Scalar; my $result; tie *STDOUT, 'IO::Scalar', \$result; print 'some stuff'; $result; } }); print "|||$data|||\n";

    If you want to run a perl script change the print line to do 'somefile.pl';

      Thats an interesting idea, my only problem is that the entire script has to be recompiled and reexecuted every time I try to run it. The main reason I'm playing with Perl.pm is to be able to "cache" the compilation of perl scripts, for speed purposes. Theoretically, with the Perl->new() method, it will load and compile the script, then I can run it multiple times with the ->run method. Maybe. In your method it would have to get reloaded every time, I think.
Re: Challenge: Capturing stdout from a function call.
by Anonymous Monk on Oct 22, 2004 at 21:51 UTC
    Duh, very simple, just use TIE:
    package IO::Redirect ; sub TIEHANDLE { my $class = shift ; my ($stdout , $globpath) = @_ ; my $prevstdout = \*{$globpath} ; my $this = { STDOUT => $stdout , PREVIO => $prevstdout , PREVIOPATH +=> $globpath } ; return bless($this , $class) ; } sub print { &PRINT ;} sub print_stdout { my $this = shift ; return 1 if $_[0] eq '' ; my $stdout = $this->{STDOUT} ; if ( ref($stdout) eq 'SCALAR' ) { $$stdout .= $_[0] ;} elsif ( ref($stdout) eq 'CODE' ) { &$stdout($this , $_[0]) ;} else { print $stdout $_[0] ;} return 1 ; } sub PRINT { my $this = shift ; $this->print_stdout( join("", (@_[0..$#_])) ) ; return 1 ; } sub PRINTF { &PRINT($_[0],sprintf($_[1],@_[2..$#_])) ;} sub CLOSE { my $this = shift ; untie *{ $this->{PREVIOPATH} } ; } sub UNTIE { my $this = shift ; *{ $this->{PREVIOPATH} } = $this->{PREVIO} ; } sub DESTROY { &CLOSE } ####### # END # ####### package main ; my $catcher ; tie(*{"main::STDOUT"} => 'IO::Redirect' , \$catcher , 'main::STDOUT' +) ; print "Hello World!\n" ; close( *main::STDOUT ) ; print "<<$catcher>>\n" ; exit;
    By gmpassos
      What a brilliant ide! It's too bad tie doesn't work. Maybe you should try testing your solution first?
        Tested on Perl 5.6.1 and it works. Depending on your Perl version you need to add the sub STORE {} to no get errors.

        Graciliano M. P.
        "Creativity is the expression of liberty".