Hijacking STDOUT Into a String

The answer is local *STDOUT:

my $output = '';
{
    open my $fh, '>', \$output or die $!;
    local *STDOUT = $fh;

    print "This goes into \$output\n";
    print "So does this\n";
}

# STDOUT is restored here
print "This goes to the terminal\n";
say "Captured: $output";

This is dynamic scoping at its finest. Any code called from within that block, no matter how deep the call stack goes, sees the replaced STDOUT. The function you are capturing from does not need to know or cooperate.

Part 3: CAPTURING MODULE OUTPUT

use Data::Dumper;

my $dump_text;
{
    open my $fh, '>', \$dump_text or die $!;
    local *STDOUT = $fh;
    print Dumper({ name => 'perl', version => 5.40 });
}

# $dump_text now contains the Dumper output
# parse it, log it, email it, whatever
if ($dump_text =~ m~'perl'~)
{
    say "Found perl in the dump";
}

You never touch the module's source code. You never fork a process. You just temporarily bend STDOUT.

Part 4: A CLEAN CAPTURE FUNCTION

sub capture_stdout
{
    my ($code) = @_;
    my $output = '';

    {
        open my $fh, '>', \$output or die "Cannot redirect STDOUT: $!";
        local *STDOUT = $fh;
        $code->();
    }

    return $output;
}

# usage
my $text = capture_stdout(sub {
    print "line one\n";
    print "line two\n";
    some_noisy_function();
});

say "Captured " . length($text) . " bytes";

Part 5: CAPTURING STDERR TOO

my $errors = '';
{
    open my $fh, '>', \$errors or die $!;
    local *STDERR = $fh;
    warn "This warning goes into \$errors\n";
    system("ls /nonexistent 2>&1");  # more on system() later
}

say "Captured errors: $errors";

my ($out, $err) = ('', '');
{
    open my $out_fh, '>', \$out or die $!;
    open my $err_fh, '>', \$err or die $!;
    local *STDOUT = $out_fh;
    local *STDERR = $err_fh;

    print "normal output\n";
    warn "error output\n";
    do_something_complex();
}

say "STDOUT got: $out";
say "STDERR got: $err";

Part 6: TESTING PRINT-HEAVY CODE

use Test::More;

sub generate_report
{
    print "=== Report ===\n";
    print "Items: 42\n";
    print "Status: OK\n";
}

# capture and test the output
my $report;
{
    open my $fh, '>', \$report or die $!;
    local *STDOUT = $fh;
    generate_report();
}

like($report, qr~=== Report ===~,  'has header');
like($report, qr~Items: \d+~,      'has item count');
like($report, qr~Status: OK~,      'status is OK');

done_testing();

The module Capture::Tiny on CPAN does this same thing with a nicer API, but understanding the mechanism means you can do it anywhere without installing anything.

Part 7: THE SYSTEM() GOTCHA

my $output = '';
{
    open my $fh, '>', \$output or die $!;
    local *STDOUT = $fh;

    print "this IS captured\n";
    system("echo 'this is NOT captured'");  # goes to terminal!
}

say $output;    # only contains "this IS captured\n"

If you need to capture external command output, use backticks or open with a pipe:

my $cmd_output = `echo 'hello from the shell'`;

# or with open
open my $pipe, '-|', 'echo', 'hello from the pipe' or die $!;
my $piped = do { local $/; <$pipe> };
close $pipe;

Part 8: READING FROM IN-MEMORY STRINGS

my $data = "line one\nline two\nline three\n";
open my $fh, '<', \$data or die $!;

while (my $line = <$fh>)
{
    chomp $line;
    say "Read: $line";
}

close $fh;

my $fake_input = "yes\n42\nquit\n";
{
    open my $fh, '<', \$fake_input or die $!;
    local *STDIN = $fh;

    # code that reads from STDIN now reads from $fake_input
    my $answer = <STDIN>;    # gets "yes\n"
    my $number = <STDIN>;    # gets "42\n"
    my $cmd    = <STDIN>;    # gets "quit\n"
}

Part 9: APPENDING AND LAYERING

my $log = "=== Start ===\n";

open my $fh, '>>', \$log or die $!;
print $fh "Entry 1\n";
print $fh "Entry 2\n";
close $fh;

say $log;
# === Start ===
# Entry 1
# Entry 2

my $combined = '';

for my $func (\&report_users, \&report_disk, \&report_services)
{
    open my $fh, '>>', \$combined or die $!;
    local *STDOUT = $fh;
    $func->();
}

# $combined now has all three reports concatenated

Part 10: THE FULL PICTURE

#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Time::HiRes qw(gettimeofday tv_interval);

sub capture_all
{
    my ($code) = @_;
    my ($stdout, $stderr) = ('', '');
    my $t0 = [gettimeofday];

    {
        open my $out_fh, '>', \$stdout or die $!;
        open my $err_fh, '>', \$stderr or die $!;
        local *STDOUT = $out_fh;
        local *STDERR = $err_fh;
        $code->();
    }

    my $elapsed = tv_interval($t0);

    return {
        stdout  => $stdout,
        stderr  => $stderr,
        elapsed => $elapsed,
    };
}

# usage
my $result = capture_all(sub {
    print "Processing...\n";
    warn "Minor issue detected\n";
    print "Done.\n";
});

say "STDOUT: $result->{stdout}";
say "STDERR: $result->{stderr}";
say "Took: $result->{elapsed}s";

      .--.
     |o_o |     "STDOUT goes where I tell it.
     |:_/ |      Not where it wants to go."
    //   \ \
   (|     | )
  /'\_   _/`\
  \___)=(___/

Functions that print become functions that return strings. Code that was untestable becomes trivially testable. Output you could only see on a terminal becomes data you can parse, filter, and transform.

It is one of those Perl features that makes you wonder why every language does not work this way. Open a filehandle to a variable. Redirect output into it. Get your data. Done.