Hmmm, it would be a dream come true if it worked, but alas I get either nasty recursion errors or reference errors when trying this on 5.8. Basically we tie both STDOUT and STDERR to themselves and a logfile.
tie *STDOUT, 'InstallerHandleTie', $outfile, *STDOUT; tie *STDERR, 'InstallerHandleTie', $outfile, *STDERR;
InstallerHandleTie opens $outfile and saves both it's handle and STDOUT/STDERR. We override print and printf to print to the list of handles. Code shown below:
package InstallerHandleTie; use strict; no strict 'refs'; use FileHandle; use Tie::Handle; our @ISA = qw (Tie::StdHandle); use File::Basename; use File::Path; my $handleId = 0; # this is a class variable so multiple ties # to same file will create different handles sub TIEHANDLE { my $class = shift; my @handles = (); # see if each handle is a filename or a real handle foreach my $h (@_) { if ($h =~ /^\*/ or ref $h eq 'GLOB') { # it's a handle (ie *package::name) or a glob push @handles, $h; $h->autoflush(1); } else { # assume it is a file name and try to open # create a handle name based on my $hname = "_FH_$handleId"; $handleId++; my $dir = dirname($h); if (!-e $dir or !-d $h) { mkpath($dir); } open($hname, ">$h") or die "unable to open file '$h': $!"; $hname->autoflush(1); push @handles, $hname; } } return bless \@handles, $class; } sub PRINT { my $self = shift; my $result = 0; foreach my $handle (@$self) { $result += print $handle @_ if (fileno($handle)); } return ($result == @$self); } sub PRINTF { my $self = shift; my $result = 0; foreach my $handle (@$self) { $result += printf $handle @_ if (fileno($handle)); } return ($result == @$self); } 1; # required 1 to end the Perl module
I have played around with various forms of *STDOUT{IO} etc. But as long as STDOUT or STDERR are self tied it doesn't work and I get recursion. I was able to save *STDOUT, then do a local *STDOUT, then do the tie by passing in the saved value instead of the local value and this worked. The problem came in when I tried to do the same with STDERR. In this case all the output from STDERR disappeared. If I swapped the STDERR and STDOUT ties done in this manner, I would then get STDERR output and not STDOUT.
my $gfh = *STDOUT; my $geh = *STDERR; foreach my $outfile (@logs) { local *STDOUT; local *STDERR; tie *STDOUT, 'InstallerHandleTie', $outfile, $gfh; tie *STDERR, 'InstallerHandleTie', $outfile, $geh; print "Writing to $outfile\n"; warn "Writing warning to $outfile\n"; untie *STDOUT; untie *STDERR; }
Doing this results in the print getting to the log file, but warn does not.
Thanks! Rick
In reply to Re^2: Porting Perl 5.6 to Perl 5.8 issue with self-tie
by fwashbur
in thread Porting Perl 5.6 to Perl 5.8 issue with self-tie
by fwashbur
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |