How can I send Perl output to a both STDOUT and a variable?

Question

I would like to send the output from a command to both STDOUT and to a variable. I want to combine:

my $var = `some command` ;   
system( 'some command' ) ;

Tee is a step in the right direction but this sends it to a file rather than to a variable. I guess I could then read the file but it would be simpler to get it straight there.

I wrote Capture::Tiny to overcome the limitations of Tee. See my reply below for an example. — xdg, Mar 12 '09 at 01:26

Alnitak · Answer 1 · 2009-03-11T13:39:45.170

15

Does the output to both streams have be simultaneous?

If not, you could do:

my $var = 'cmd'
my $output = `$cmd`
print STDOUT $output

or for a safer version, which doesn't involve invoking a subshell, and prints to STDOUT a line at a time:

sub backtick(@)
{
    my $pid = open(KID, '-|');
    die "fork: $!" unless defined($pid);
    if ($pid) {
        my $output;
        while (<KID>) {
            print STDOUT $_;
            $output .= $_; # could be improved...
        }
        close(KID);
        return $output;
    } else {
        exec @_;
    }
}

my @cmd = ('/bin/ls', '-l');
my $output = backtick(@cmd);

edited Mar 11 '09 at 13:39

answered Mar 11 '09 at 13:33

Alnitak

334,560
70
407
495

Yes - I would like hte output to STDOUT to be simulataneous - it might be quite long and it would give the user a warm feeling htat something is happening. – justintime Mar 11 '09 at 13:42
can you talk more about `my $pid = open(KID, '-|');` and how this works? – gbtimmon Oct 08 '12 at 21:25
1

Nevermind I've figured it out `my $pid = open(KID, '-|');` forks the current process, the child process exec the command in the else block and the parent process sits, waits, and reads from the child as it produces the output. Makes sense... thanks for posting this. – gbtimmon Oct 08 '12 at 21:27

score 9 · Accepted Answer · answered Mar 12 '09 at 01:25

9

You want Capture::Tiny

use Capture::Tiny 'tee';
my $output = tee { system( "some command" ) };

I wrote it to replace Tee and about 20 other modules that do some sort of capturing but are flawed in one way or another.

-- xdg (aka dagolden)

answered Mar 12 '09 at 01:25

xdg

2,975
19
17

This didn't work for me on Windows, Perl wraps a C++ launcher which launches a C# program. All the log output goes to the console but I can't get the same output to a file. Any advice would be appreciated although I appreciate this isn't much to go on! – gav Nov 25 '11 at 15:12
yes,this is not working on windows.Is their any other approach?? – Aug 29 '16 at 18:15

score 2 · Answer 3 · edited May 23 '17 at 10:32

2

Perhaps my answer here can help you: How can I hook into Perl’s print?

edited May 23 '17 at 10:32

Community

1
1

answered Mar 11 '09 at 15:09

Axeman

29,660
2
47
102

I can't see how - it's not Perl that's doing the output, it's the child process. – Alnitak Mar 11 '09 at 15:37

spoulson · Answer 4 · 2009-03-12T02:45:36.060

1

You could use the IO::String module to select() STDOUT to a string and then call system() to run the command. You can collect the output from the IO::String handle. This effectively does what the backtick syntax does.

So to gather command output realtime, run the system() command asynchronously through fork() or some other means and poll the handle for updates.

EDIT: Per OP, it turns out this approach does not work. select() doesn't affect system() calls.

Also, IO::String has been replaced with new open() syntax since Perl 5.8 that does the same function.

edited Mar 12 '09 at 02:45

answered Mar 11 '09 at 14:39

spoulson

21,335
15
77
102

Since perl 5.8 you can open a FH directly to a variable, e.g., open(my $fh, ">" \my $variable) or die "Err: $!". So no more need for IO::String (or IO::Scalar, etc.) – runrig Mar 11 '09 at 16:46
It seems that select doesn't redirect output from "system" which is a pity. – justintime Mar 11 '09 at 20:28

score 1 · Answer 5 · answered Mar 11 '09 at 21:40

1

You can do this through a file handle as well. Not as elegant as some solutions, but it would likely work. Something along the lines of:

my $foo;
open(READ, "env ps |");
while (<READ>) {
    print;
    $foo .= $_;
}
print $foo;
close(READ);

answered Mar 11 '09 at 21:40

Jack M.

30,350
7
55
67

score 0 · Answer 6 · answered Feb 05 '13 at 16:51

0

my $output = system("your command | tee /dev/tty");

Worked for me!!

answered Feb 05 '13 at 16:51

hamzah

1

score 0 · Answer 7 · answered Jun 11 '11 at 10:37

    package Logger ; 
    # docs at the end ... 
    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

score 0 · Answer 8 · answered Mar 11 '09 at 14:28

0

Send the output from the Tee module to /dev/stdout (or /dev/fd/1).

answered Mar 11 '09 at 14:28

Jonathan Leffler

730,956
141
904
1,278

That assumes that such a thing exists on the target OS, and there's no indication that it does. – brian d foy Mar 11 '09 at 21:16
Well, yes, it does make that assumption, and if the o/s does not support it, then no, this answer does not apply. But where the /dev/stdout facility is available, it makes it trivial to apply Tee. – Jonathan Leffler Mar 11 '09 at 21:21

How can I send Perl output to a both STDOUT and a variable?

8 Answers8

Linked

Related