Subroutine for piping stdout and stderr into file

Question

If I have a program called simplecalc.pl:

use v5.10; 
use warnings;
use strict;

# SIMPLE CALCULATOR
# Usage: simplecalc.pl <n1> <n2> [<verbose> <logswitch>]
# Example Usage:
# normal usage      : simplecalc.pl 4 2  
# verbose usage     : simplecalc.pl 4 2 1
# support-case usage: simplecalc.pl 4 2 0 1

my($OK,$UNKNOWN)=(0,3);
my($filename, $endmsg, $exit) = ('my.log', undef, undef);
my($n1, $n2, $DEBUG, $GET_SUPPORT_FILE) = @ARGV;

# Handling of the support-file starts here ===============================
*ORIGINAL_STDOUT = *STDOUT;

if ($GET_SUPPORT_FILE) {
    $DEBUG = 1;
    $endmsg = "support-info sucessfully written into $filename";
    $exit = $UNKNOWN;
    # redirect stdout and stderr
    open my $stdout_txt, '>>:utf8', "$filename";
    *STDOUT = $stdout_txt;
    open STDERR, '>&STDOUT';
} else {
    $endmsg = "Finnished calculation - good bye.";
    $exit = $OK;
}

END {
    select *ORIGINAL_STDOUT;
    say $endmsg;
};
# end of support-file handling ============================================


say STDERR "INFO: got $n1 and $n2 from the commandline" if $DEBUG;
say "Hello, let me calc the quotient from $n1 trough $n2 for you ...";
my $quotient = $n1 / $n2;
say "Quotient: $quotient";

exit $exit;

Is there a way to put the lengthy handling of the support-file in a reusable way into a module? (The support-file is meant to be sent by the user to the program-maintainer.)

Note: The above solution also works for simplecalc.pl 4 0 0 1 which results in a division trough 0. Catching a die in any module used by the main-programm and write the die-msg into the support-file is an important feature.

Answer 1

I take the question to want to control redirection of both streams from a module.

Something like this basic example?

RedirectStreams.pm

package RedirectStreams;

use warnings;
use strict;

use Exporter qw(import);
our @EXPORT_OK = qw(redirect_streams restore_streams);

our ($stdout, $stderr) = (*STDOUT, *STDERR);

sub redirect_streams {
    my ($handle) = @_;
    *STDOUT = $handle;
    *STDERR = $handle;
}

sub restore_streams {
    *STDOUT = $stdout;
    *STDERR = $stderr;
}

1;

main.pl

use warnings;
use strict;

use RedirectStreams qw(redirect_streams restore_streams);

my $logfile = shift @ARGV  || 'streams.log';

say "Hello from ", __PACKAGE__;            
warn "WARN from ", __PACKAGE__;

open my $fh, '>', $logfile;
    
redirect_streams($fh);

say "\tHi to redirected";
warn "\tWARN to redirected";

restore_streams();
    
say  "Hi to STDOUT again";
warn "WARN in main again";

open my $fh_other, '>', 'other_' . $logfile;
redirect_streams($fh_other);
say  "STDOUT redirected to another";
warn "STDERR redirected to another";

close $_ for $fh, $fh_other;

Output on console is (aligned)

Hello from main
WARN from main      at ... line 18.
Hi to STDOUT again
WARN in main again  at ... line 29.

while the file streams.log has

        Hi to redirected
        WARN to redirected at ... line 24.

and other_streams.log has its two lines. (Tabbed to spot easily if they wind up on console.)

The responsibility for managing filehandles in this example rests on the caller.

This should be completed with all manner of error checking, options in subs (redirect only one stream, or each to its own file, etc), and probably a few more convenience routines.

---

Note that our $stdout = *STDOUT creates an alias.

Another way to preserve STDOUT for later restoration is to duplicate it,

open my $stdout, '>&', STDOUT;

This creates an independent filehandle, made as a duplicate of STDOUT (what is all we need here), which is unaffected by changes (or closure) of STDOUT. See this post for an example use.

Answer 2

I'm guessing you're looking for select which changes the default file handler in print and say. And END which is run right before the program ends.

use v5.10; use warnings; use strict;
my($OK,$UNKNOWN)=(1,0);

my($filename, $endmsg, $exit) = ('my.log', 'OK', $OK);
END { say $endmsg }
my $DEFAULT_FH=select;  #select returns current default file handler (often STDOUT)
if( rand()<0.5){        #half the time, for test
    open my $FH, '>>:utf8', $filename or die; #append
    $endmsg = qq{support-info successfully written into $filename};
    $exit = $UNKNOWN;
    select $FH;
}

print "print something\n";
say   "say something more"; #same as print except \n is added

if(1){
    select $DEFAULT_FH;     #or just:  select STDOUT
}
exit $exit;