sintaxis read open manejo crear copiar comandos array archivos perl stdout tee

read - sintaxis de perl



¿Cómo obtener una salida de código perl para STDOUT/STDERR y un archivo, en tiempo real y multiplataforma? (5)

Necesito obtener el resultado del código Perl normal en la pantalla y en un archivo de registro al mismo tiempo. Sin embargo, el problema es que el tiempo de ejecución de la herramienta puede ser horas. Usar la T de Capture :: Tiny significa que el archivo de registro solo se escribirá una vez que finalice la secuencia de comandos, lo que no es muy útil.

Para complicar aún más las cosas, necesito capturar el resultado del perl directo del mismo proceso, así como el de los procesos llamados con system ().

Por último, debido a las restricciones del empleador, también debe funcionar en Win32.

¿Qué otras opciones tengo?


Puedes usar IO :: Tee .

  • Crea un identificador de archivo especial en forma de T.
  • Edita tu programa. Cambia todas las impresiones a stdout en impresiones en este identificador de archivo.
  • Cuando se requiera, redefina el identificador de archivo en forma de T para imprimir solo en formato estándar, o para imprimir en 2 o más archivos.
  • Use `` instead os system () para capturar los resultados de los programas e imprimirlos en el manejador de archivos especial.

Si prefiere no usar ningún módulo, cree su propia función "myprint". Se puede imprimir en stdout y, si se activa una bandera global, imprimir en un archivo de registro también.

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


Si su programa se ejecuta en una plataforma Linux / Unix, entonces puede usar el comando tee . Tee lee stdin y escribe en stdout y en un archivo especificado.

Ejemplo:

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

La única advertencia es que stdout y stderr se fusionarán en el mismo archivo.

Como se encuentra en una plataforma Windows, puede buscar Google por tee.exe o puede probar esta versión minimalista de 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! }

Ejemplo:

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

Realmente trataría de evitar modificar el código fuente solo para capturar STDOUT y / o STDERR más y más si va a hacer llamadas al sistema.


Use PerlIO :: Util .

Acabo de probarlo con Strawberry Perl 5.12.1 32 bit y funciona perfectamente, por lo que será multiplataforma. El siguiente código hace exactamente lo que esperas. Y dado que modifica los manejadores de archivo STDOUT y STDERR reales, cualquier escritura en ellos se ejecutará automáticamente.

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; }


Como ninguna de las soluciones presentadas fue satisfactoria, me senté y resolví el problema por mi cuenta:

Capture :: Tiny :: Extended


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 [email protected] =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