in reply to Need Help: Capture Print Outputs from a Function

Here's one way 

#! perl -sw
use strict;

sub immutable {
    print "immutable received args: [ @_ ]\n";
    print "Some more stuff\n";
}

## Save a copy of STDOUT
open SAVED, '>&=STDOUT';
close STDOUT;

## Open STDOUT to a variable (ramfile)(Requires 5.8.x)
open STDOUT, '>', \ my( $var ) or die $!;

## Call the sub
immutable( qw[ some args here ] );

## Close the ramfile
close STDOUT;

## Redirect STDOUT back to it's original place
open STDOUT, '>&=SAVED' or die $!;

## Discard the backup
close SAVED;

## Use the captured output
print "The variable \$var now contains:\n'$var'\n";
__END__
C:\test>junk2
The variable $var now contains:
'immutable received args: [ some args here ]
Some more stuff
'

[download]
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

Replies are listed 'Best First'.
Re^2: Need Help: Capture Print Outputs from a Function
by chromatic (Archbishop) on May 02, 2006 at 20:31 UTC

    That's a lot of work to avoid using select.

[reply]

      True, but it is guarenteed to work even if someone uses print STDOUT stuff;, when select won't.

      The case of that where I got bitten is when you pass \*STDOUT to some module and internally it uses 

      printf { $self->{fh} } "%s\n", 'stuff';

      [download]

      Which is not a completely uncommon scenario.

      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]
        Good point! Maybe I'll start using argless select instead of *STDOUT.
[reply]
[d/l]
[select]

      I prefer 

      {
   open local *STDOUT, '>', \$buf;
   ...
}

      [download]
      over 
      open TEMP, '>', \$buf;
my $old_select = select(TEMP);
...
select($old_select);

      [download]

      since the former restores STDOUT even in the case of exceptions. The former, however, doesn't work if someone has previously called select. I guess the comprehensive solution would be: 

      {
   my $old_select = select();
   my $handle = on_release { select($old_select); };
   open local *STDOUT, '>', \$buf;
   select(STDOUT);
   ...
}

      [download]

      It even handles exceptions thrown by signal handlers.

      Updated.

[reply]
[d/l]
[select]
        my $handle = on_release { select($old_select); };

        What is on_release?

        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom