How to get perl code output to STDOUT/STDERR and a file, in realtime and cross-platform?

Question

I need to get the output of normal Perl code to the screen and into a logfile at the same time. However a problem is that the runtime of the tool can be hours. Using Capture::Tiny's tee that means the log file will only be written to once the script terminates, which is not very useful.

To further complicate things, i need to capture the output of straight perl from the same process, as well as that of processes called with system().

Lastly, due to employer restrictions it needs to work on Win32 as well.

What other options do i have?

score 4 · Answer 1 · answered Mar 16 '11 at 13:35

Use PerlIO::Util.

Just tested it under Strawberry Perl 5.12.1 32 bit and it works perfectly, so it'll be cross platform. The below code does exactly as you'd expect. And since it modifies the actual STDOUT and STDERR file handles, any writes to them will automatically be teed.

use strict;
use warnings;

use IO::Handle;
use PerlIO::Util;
use 5.012;

for (*STDOUT, *STDERR) {
  $_->autoflush; $_->push_layer(tee => ">>stdout.txt");
}

for (1..10) {
  say $_;
  warn $_ unless $_ % 2;
}

Yeah, i tried that one too and really liked it. However, if you add something like `system( 'dir' );`, it won't catch that. — Mithaldu, Mar 16 '11 at 14:13

score 2 · Accepted Answer · answered Mar 20 '11 at 10:29

2

Since none of the presented solutions were satisfactory i sat down and solved the problem on my own:

Capture::Tiny::Extended

answered Mar 20 '11 at 10:29

Mithaldu

2,393
19
39

Francisco R · Answer 3 · 2011-03-16T10:32:08.963

1

If your program runs on a Linux/Unix platform, then you can use tee command. Tee reads stdin and writes to stdout and to a specified file.

Example:

myprogram.pl  2>&1 |tee mylog.txt

The only caveat is that stdout and stderr will be merged in the same file.

Since you are on a Windows platform, you can search Google por tee.exe, or you can try this minimalistic perl version of tee:

$|=1;

if ( !$ARGV[0] ) {
        print "Usage:  some_command  \|  tee.pl [-a]  logfile\n";
        exit(1);
}

# Append mode
my $mode='>';
if ($ARGV[0] eq '-a')
{
        $mode='>>';
        shift;
}
my $LOGFILE=$ARGV[0];

while (<STDIN>) {
        print;
        open( OUT, "$mode $LOGFILE");
        print OUT $_;
        close OUT;

        # Your logic here!
}

Example:

perl myprogram.pl  2>&1 |perl tee.pl mylog.txt

I would really try to avoid modifying source code just to capture STDOUT and/or STDERR more and more if you are going to make system calls.

edited Mar 16 '11 at 10:32

answered Mar 16 '11 at 09:52

Francisco R

4,032
1
22
37

I don't mind the output being merged, but due to employer restrictions it needs to work on Win32 as well. – Mithaldu Mar 16 '11 at 10:00
I modified my answer. Hope it helps. – Francisco R Mar 16 '11 at 10:27
Yeah, that is an option, but it's more the last resort kind of thing. The script i'm writing needs to start and capture other script and wraps lockfile logic, error catching, emailing, etc. around them. And *all* of this needs to go into one log file, which Capture::Tiny does very well. Just not in realtime. – Mithaldu Mar 16 '11 at 10:28
Please clarify. Do you just need to capture your program output? Then tee is your friend. Do you need a realtime log processor? Then may be you can use my perl tee and modify it to parse lines. – Francisco R Mar 16 '11 at 10:36
Sorry if i'm unclear. I have a tool that needs to always print to the screen and which ALSO needs to be able to start logging all its output to a file if the logic within it dictates that. That output can come from the tool itself printing debug info about things like lockfile handling, but also whatever comes out of system() calls it does. – Mithaldu Mar 16 '11 at 11:32

score 1 · Answer 4 · answered Mar 16 '11 at 12:18

You can use IO::Tee.

Create an special tee filehandle.
Edit your program. Change all prints to stdout into prints to this filehandle.
When required, redefine the tee filehandle to print to stdout only, or to print to 2 or more files.
Use `` instead os system() to capture programs output and print them to the special filehandle.

If you prefer not using any module, create your own "myprint" function. It could print to stdout and, if a global flag is enabled, print to a logfile too.

sub myPrint
{
   print @_;
   if ($LOGMODE)
   {
      open(LOGFILE, ">>$logfile");
      print LOGFILE @_;
      close LOGFILE;
   }
}

Those aren't all full solutions, but they pointed me a workable path. I'll add a toggle to switch the kind of logging it does and make use of `open(STDOUT, ">>logfile");` or `Use Capture::Tiny` as appropiate; since only those seem to be able to capture system(). — Mithaldu, Mar 16 '11 at 14:15

Yordan Georgiev · Answer 5 · 2011-06-23T15:52:14.063

    package Logger ; 
    # docs at the end ... 
            # capture conditionally the output of the command
            # $objLogger->LogDebugMsg ( "Running $cmd : \n $cmd " ) ; 
            # $objLogger->LogDebugMsg ( `$cmd 2>&1` ) ; 

    use lib '.' ; use strict ; use warnings ; use Carp qw(cluck); 

    our ( $MyBareName  , $LibDir , $RunDir ) = () ; 

    BEGIN {     


        $RunDir = '' ; 
        $0 =~ m/^(.*)(\\|\/)(.*)\.([a-z]*)/; 
        $RunDir = $1 if defined $1 ; 
        push ( @INC , $RunDir) ;    
        #debug print join ( ' ' , @INC ) ; 

    } #eof sub

    use Timer ; use FileHandler ; 

    # the hash holding the vars 
    our $confHolder = () ; 

    # ===============================================================
    # START OO


    # the constructor 
    sub new {

        my $self = shift;
        #get the has containing all the settings
        $confHolder = ${ shift @_ } ;                                           
        # Set the defaults ...
        Initialize () ;     
        return bless({}, $self);
    } #eof new 


    BEGIN { 

            # strip the remote path and keep the bare name
            $0=~m/^(.*)(\\|\/)(.*)\.([a-z]*)/; 
            my ( $MyBareName , $RunDir ) = () ; 
            $MyBareName = $3; 
            $RunDir= $1 ; 

            push ( @INC,$RunDir ) ; 

    } #eof BEGIN


    sub AUTOLOAD {

        my $self = shift ; 
        no strict 'refs'; 
            my $name = our $AUTOLOAD;
            *$AUTOLOAD = sub { 
        my $msg = "BOOM! BOOM! BOOM! \n RunTime Error !!!\nUndefined Function $name(@_)\n" ;
        print "$self , $msg";
            };
            goto &$AUTOLOAD;    # Restart the new routine.
    }   

    sub DESTROY {

        my $self = shift;
        #debug print "the DESTRUCTOR is called  \n" ; 
        return ; 
    } 

    END { 

        close(STDOUT) || die "can't close STDOUT: $! \n\n"  ; 
        close(STDERR) || die "can't close STDERR: $! \n\n" ; 
    }

    # STOP OO
    # =============================================================================

    sub Initialize { 

        $confHolder = { Foo => 'Bar' ,   } unless ( $confHolder ) ; 
        # if the log dir does not exist create it 
        my $LogDir = '' ; 
        $LogDir = $confHolder->{'LogDir'} ; 

        # create the log file in the current directory if it is not specified 
        unless ( defined ( $LogDir )) {
        $LogDir = $RunDir  ; 
        }

    use File::Path qw(mkpath);

        if( defined ($LogDir) &&  !-d "$LogDir" ) {  
                mkpath("$LogDir") || 
                cluck ( " Cannot create the \$LogDir : $LogDir $! !!! "  ) ; 
        }

        # START set default value if value not specified =========================
        # Full debugging ....
            $confHolder->{'LogLevel'} = 4   
                    unless ( defined ( $confHolder->{'LogLevel'} ) )  ; 

            $confHolder->{'PrintErrorMsgs'} = 1     
                    unless ( defined ( $confHolder->{'PrintErrorMsgs'} ) )  ; 

            $confHolder->{'PrintDebugMsgs'} = 1 
                    unless ( defined ($confHolder->{'PrintDebugMsgs'})) ; 

            $confHolder->{'PrintTraceMsgs'} = 1 
                    unless ( defined ( $confHolder->{'PrintTraceMsgs'} )) ; 

            $confHolder->{'PrintWarningMsgs'} = 1   
                    unless ( defined ( $confHolder->{'PrintWarningMsgs'} ) )  ; 

            $confHolder->{'LogMsgs'} = 1
                    unless ( defined ( $confHolder->{'LogMsgs'} ) )  ; 

            $confHolder->{'LogTimeToTextSeparator'} = '---'
                    unless ( defined ( $confHolder->{'LogTimeToTextSeparator'} ) )  ; 


        #
        # STOP set default value if value not specified =========================

    } #eof sub Initialize

    # =============================================================================
    # START functions


    # logs an warning message
    sub LogErrorMsg {

        my $self = shift ; 
        my $msg = "@_" ; 
        my $msgType = "ERROR" ; 

        # Do not print anything if the PrintWarningMsgs = 0 
        return if ( $confHolder->{'LogMsgs'} == 0 )     ; 

        # Do not print anything if the PrintWarningMsgs = 0 
        return if ( $confHolder->{'PrintErrorMsgs'} == 0 )  ; 

        $self->LogMsg( $msgType , "$msg" ) if ( $confHolder->{'PrintErrorMsgs'} == 1 ) ; 

    } #eof sub

    # logs an warning message
    sub LogWarningMsg {

        my $self = shift ; 
        my $msg = "@_" ; 
        my $msgType = 'WARNING' ; 

        # Do not print anything if the PrintWarningMsgs = 0 
        return if ( $confHolder->{'LogMsgs'} == 0 )     ; 

        # Do not print anything if the PrintWarningMsgs = 0 
        return if ( $confHolder->{'PrintWarningMsgs'} == 0 )    ; 

        $self->LogMsg( $msgType , "$msg" ) if ( $confHolder->{'PrintWarningMsgs'} == 1 ) ;  

    } #eof sub



    # logs an info message
    sub LogInfoMsg {

        my $self = shift ; 
        my $msg = "@_" ; 
        my $msgType = 'INFO' ; 

        # Do not print anything if the PrintWarningMsgs = 0 
        return if ( $confHolder->{'LogMsgs'} == 0 )     ; 

        # Do not print anything if the PrintWarningMsgs = 0 
        return if ( $confHolder->{'PrintInfoMsgs'} == 0 )   ; 

        $self->LogMsg( $msgType , "$msg" ) if ( $confHolder->{'PrintInfoMsgs'} == 1 ) ;  

    } #eof sub

    # logs an trace message
    sub LogTraceMsg {

        my $self = shift ; 
        my $msg = "@_"  ; 
        my $msgType = 'TRACE' ; 
        my ($package, $filename, $line) = caller();     


        # Do not print anything if the PrintDebugMsgs = 0 
        return  if ( $confHolder->{'PrintTraceMsgs'} == 0 )      ; 

        $msg = "$msg : FROM Package: $package  FileName: $filename Line: $line  "  ; 

        # Do not print anything if the PrintWarningMsgs = 0 
        return if ( $confHolder->{'LogMsgs'} == 0 )     ; 

        # Do not print anything if the PrintWarningMsgs = 0 
        return if ( $confHolder->{'PrintTraceMsgs'} == 0 )  ; 

        $self->LogMsg( $msgType , "$msg" ) if ( $confHolder->{'PrintTraceMsgs'} == 1 ) ;  

    } #eof sub

    # logs an Debug message
    sub LogDebugMsg {

        my $self = shift ; 
        my $msg = "@_" ; 
        my $msgType = 'DEBUG' ; 

        # Do not print anything if the PrintWarningMsgs = 0 
        return if ( $confHolder->{'LogMsgs'} == 0 )     ; 

        # Do not print anything if the PrintWarningMsgs = 0 
        return if ( $confHolder->{'PrintDebugMsgs'} == 0 )  ; 

        $self->LogMsg( $msgType , "$msg" ) if ( $confHolder->{'PrintDebugMsgs'} == 1 ) ;  

    } #eof sub

    sub GetLogFile {

            my $self = shift ; 
            #debug print "The log file is " . $confHolder->{ 'LogFile' } ;  
            my $LogFile = $confHolder->{ 'LogFile' } ; 

            #if the log file is not defined we create one 
            unless  ( $confHolder->{ 'LogFile' } ) { 

                $LogFile = "$0.log"  ;

            }

            return $LogFile ; 
    } #eof sub 

    sub BuildMsg { 

    my $self = shift ; 
    my $msgType = shift ; 

    my $objTimer= new Timer(); 
    my $HumanReadableTime = $objTimer->GetHumanReadableTime(); 
    my $LogTimeToTextSeparator = $confHolder->{'LogTimeToTextSeparator'} ; 

    my $msg = () ; 

        # PRINT TO STDOUT if 
        if (                $msgType eq 'WARNING' 
                    ||      $msgType eq 'INFO' 
                    ||      $msgType eq 'DEBUG' 
                    ||      $msgType eq 'TRACE'                     )   {

            $msg = " $HumanReadableTime $LogTimeToTextSeparator $msgType : @_ \n" ; 

        }
        elsif ( $msgType eq 'ERROR' ) {

            $msg = " $HumanReadableTime $LogTimeToTextSeparator $msgType : @_ \n" ; 

        }
        else {
            $msg = " $HumanReadableTime $LogTimeToTextSeparator $msgType @_ \n" ; 
        }



        return $msg ; 
    } #eof sub BuildMsg

    sub LogMsg { 

    my $self = shift ; 
    my $msgType = shift ; 

    my $msg = $self->BuildMsg ( $msgType , @_ ) ; 
    my $LogFile = $self -> GetLogFile();                            


    # Do not print anything if the LogLevel = 0 
    return              if ( $confHolder->{'LogLevel'} == 0 ) ; 

        # PRINT TO STDOUT if 
        if (                
                                $confHolder->{'PrintMsgs'} == 1 
                    ||      $confHolder->{'PrintInfoMsgs'} == 1 
                    ||      $confHolder->{'PrintDebugMsgs'} == 1 
                    ||      $confHolder->{'PrintTraceMsgs'} == 1 
                    )   {

            print STDOUT $msg ; 
        }

        elsif ( $confHolder->{'PrintErrorMsgs'}  ) {

            print STDERR $msg ; 
        }


        if ( $confHolder->{'LogToFile'} == 1 )  {   

            my $LogFile = $self -> GetLogFile();
            my $objFileHandler = new FileHandler();

            $objFileHandler->AppendToFile( $LogFile , "$msg"  );

        } #eof if

        #TODO: ADD DB LOGGING

    } #eof LogMsg



    # STOP functions
    # =============================================================================


    1;

    __END__



    =head1 NAME

    Logger 

    =head1 SYNOPSIS

    use Logger  ; 


    =head1 DESCRIPTION

    Provide a simple interface for dynamic logging. This is part of the bigger Morphus tool : google code morphus
    Prints the following type of output : 

    2011.06.11-13:33:11 --- this is a simple message  
    2011.06.11-13:33:11 --- ERROR : This is an error message  
    2011.06.11-13:33:11 --- WARNING : This is a warning message  
    2011.06.11-13:33:11 --- INFO : This is a info message  
    2011.06.11-13:33:11 --- DEBUG : This is a debug message  
    2011.06.11-13:33:11 --- TRACE : This is a trace message  : FROM Package: Morphus  
    FileName: E:\Perl\sfw\morphus\morphus.0.5.0.dev.ysg\sfw\perl\morphus.pl Line: 52   

    =head2 EXPORT


    =head1 SEE ALSO

    perldoc perlvars

    No mailing list for this module


    =head1 AUTHOR

    yordan.georgiev@gmail.com

    =head1 COPYRIGHT AND LICENSE

    Copyright (C) 2011 Yordan Georgiev

    This library is free software; you can redistribute it and/or modify
    it under the same terms as Perl itself, either Perl version 5.8.1 or,
    at your option, any later version of Perl 5 you may have available.



    VersionHistory: 
    1.4.0 --- 2011.06.11 --- ysg --- Separated actions of building and printing msgs. Total refactoring. Beta . 
    1.3.0 --- 2011.06.09 --- ysg --- Added Initialize 
    1.2.0 --- 2011.06.07 --- ysg --- Added LogInfoErrorMsg print both to all possible
    1.1.4 --- ysg --- added default values if conf values are not set 
    1.0.0 ---  ysg --- Create basic methods 
    1.0.0 ---  ysg --- Stolen shamelessly from several places of the Perl monks ...

    =cut

Can you provide a description for this code? Just posting ~350 lines of code doesn't really make for a good answer. I also notice it's an exact duplicate of [your other answer](http://stackoverflow.com/questions/634508/how-can-i-send-perl-output-to-a-both-stdout-and-a-variable/6315409#6315409). Please also ensure that your answers address the specific problem the user is having. Thanks. — Kev, Jun 11 '11 at 11:57
Did you miss the part where i mentioned system() and ALSO the one where i posted a proper solution for my problem already? — Mithaldu, Jun 21 '11 at 16:10
$objLogger->LogInfoMsg ( "Running $cmd : \n $cmd " ) ; $objLogger->LogInfoMsg ( `$cmd 2>&1` ) ; — Yordan Georgiev, Jun 23 '11 at 15:50
The best way to gain a new skill is not to get straight the full answer, but rather to find it by yourself. It is ok to just google the answer and paste it but next time you have a new problem you will have to search for it and google it once again ... — Yordan Georgiev, Jun 23 '11 at 16:04

How to get perl code output to STDOUT/STDERR and a file, in realtime and cross-platform?

5 Answers5

Linked

Related