Well, a quick solution would be IO::Tee. This should be nearly a drop-in replacement. A more comprehensive solution would be Log::Log4perl.

I have no way to test this tonight, mayhapse another monk will correct me if wrong, but to assign an IO::Tee to, say, STDOUT would be done something like this:

local *STDOUT = new IO::Tee(\*STDOUT, '>file.txt');
[download]

UPDATE: No, after looking at that, I don't think that will work. This is more likely too, but there is probably a shorter way:

open STDOUT, '>&', new IO::Tee(\*STDOUT, '>file.txt');
[download]

With this method, you can do silly things like:

# Append
open STDOUT, '>>&', new IO::Tee(\*STDOUT, '>file.txt');

# Save the extra file descriptor
open STDOUT, '>&=', new IO::Tee(\*STDOUT, '>file.txt');
open STDOUT, '>>&=', new IO::Tee(\*STDOUT, '>file.txt');
[download]

See open for more details.

Hi Ted,

I had played around with IO:Tee but I was unsuccessful in getting both STDOUT and STDERR to go to the same file. You have done something slightly different here, so I might play around with that some more.

Thanks! Rick

Yea, even if you can get them out to the same file, it would probably be safer to use Log::Log4perl. Any, you will get a richer logging featureset.

Ted Young

($$<<$$=>$$<=>$$<=$$>>$$) always returns 1. :-)

#!/usr/bin/perl -wl
$| = 1; # unbuffered output
print $$;
for(1,2){
    open SAVEOUT,">&STDOUT";
    my $pid = open STDOUT,"| tee log_$_";
    open STDERR, ">&STDOUT";
    print "this goes to STDOUT (log_$_)";
    warn "This goes to STDERR (log_$_)";
    sleep 1;
    print "killing $pid";
    kill 15, $pid;
    close STDOUT;
    close STDERR;
    open STDOUT,">&SAVEOUT";
}
__END__
Name "main::SAVEOUT" used only once: possible typo at tee.pl line 4.
14781
this goes to STDOUT (log_1)
This goes to STDERR (log_1) at tee.pl line 8.
killing 14782
this goes to STDOUT (log_2)
This goes to STDERR (log_2) at tee.pl line 8.
[download]

$ cat log_1 log_2
this goes to STDOUT (log_1)
This goes to STDERR (log_1) at tee.pl line 8.
this goes to STDOUT (log_2)
This goes to STDERR (log_2) at tee.pl line 8.
[download]

Of course, if you need to restore STDERR later, save that too. See open. Note that if you remove the sleep 1 line in the above code you will likely not see any output, because then the tee process gets killed too soon.

--shmem

update: fixed inconsistencies stemming from putting a oneliner into a file..

_($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}

Hey shmem,

This looks like what I'm looking for! I had tried combos of saving STDOUT and killing the tee, but not in this configuration. I'll give this a try. This could explain why I was having trouble with STDERR as well.

Thanks - Rick

Hi shmem,


I tried this scheme on my system. It ran into the same issue I had when trying the example out of the O'Reilly book. The first log works great, but the second log attempt results in the following error at the first print statement: tee: write error: Invalid argument

Are you running this on 5.8? Could there be an issue with my 'tee'?

Thanks - Rick

If anyone has ideas on how to:
1. cause output from print and printf
2. for both STDOUT and STDERR
3. to go to successive log files within the same perl 5.8 session I would be extremely grateful.

Thanks Andreas,

I did not know about this module, I'll have a look to see what it has to offer. The logging we are performing is not intensive, so it could fit the bill.

Rick

On 5.8, the upgrade notes say self tie is not allowed

Tying STDOUT/STDERR should work...can you show exactly what you were doing?

Depending on what exactly you were doing, you may need to save *STDOUT{IO}/*STDERR{IO} instead of just \*STDOUT/\*STDERR.

Hey ysth,

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;
[download]

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
[download]

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;
}
[download]

Doing this results in the print getting to the log file, but warn does not.

Thanks! Rick

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.

That's because you are essentially doing:

perl -we'open FOO, "> baz"; open BAR, "> baz"; print FOO "one\n"; prin
+t BAR "one\n";'
[download]

where FOO and BAR have independent file pointers into the same file. If you want to share a logfile between two handles, use >> to force all writes to append at the end, or open the file outside the tie handler and pass its glob to your logger.

This works for me:

use InstallerHandleTie;

my $gfh = *STDOUT;
my $geh = *STDERR;

foreach my $outfile (qw/log1 log2/) {
        open my $outfh, ">", $outfile or die "nope: $!";

   local *STDOUT;
   local *STDERR;

      tie *STDOUT, 'InstallerHandleTie', $outfh, $gfh;
      tie *STDERR, 'InstallerHandleTie', $outfh, $geh;
      print "Writing to $outfile\n";
      warn "Writing warning to $outfile\n";
      untie *STDOUT;
      untie *STDERR;
}
[download]