- STDOUT/STDERR обработать через функцию,
 andy, 06:10 , 05-Июл-07 (1)>Есть скрипт perl, который что-то выводит в STDOUT и в STDERR через
>print. Нужно не меняя print обработать этот вывод через функцию и
>перенаправить его куда-нибудь в другое место.
>Как это сделать? если правильно понял задачу, то нечто вроде этого #!/usr/bin/perl
use strict;
use warnings;
sub print_array; tie *STDOUT, 'OUT';
tie *STDERR, 'OUT'; print "qwe";
warn "oops";
print "asd"; untie *STDERR;
untie *STDOUT; print_array( OUT->get_buffer ); sub print_array {
print "res: $_\n" foreach( @_ );
} #######################################################
package OUT;
our @buffer; sub TIEHANDLE { bless {} }
sub UNTIE {}
sub PRINT { push @buffer, $_[1]; } sub get_buffer { return @buffer; }
sub clear_buffer { @buffer = (); }
__END__
что называется, quick and dirty, но как пример сойдет
- STDOUT/STDERR обработать через функцию, andy, 06:14 , 05-Июл-07 (2)
да, ну и конечно perldoc perltie, perldoc -f tie, perldoc -f bless, ну и прочее - STDOUT/STDERR обработать через функцию, jr, 09:34 , 05-Июл-07 (3)
Спасибо, andy!
Но не совсем полностью, что хотелось бы. В примере получается, что вывод будет осуществлен только после исполнения print_array( OUT->get_buffer ); Нужно другое - вывод срезу, после появления print или warn>если правильно понял задачу, то нечто вроде этого
>
>#!/usr/bin/perl
>use strict;
>use warnings;
>sub print_array;
>
>tie *STDOUT, 'OUT';
>tie *STDERR, 'OUT';
>
>print "qwe";
>warn "oops";
>print "asd";
>
>untie *STDERR;
>untie *STDOUT;
>
>print_array( OUT->get_buffer );
>
>sub print_array {
> print "res: $_\n" foreach( @_ );
>}
>
>#######################################################
>package OUT;
>our @buffer;
>
>sub TIEHANDLE { bless {} }
>sub UNTIE {}
>sub PRINT { push @buffer, $_[1]; }
>
>sub get_buffer { return @buffer; }
>sub clear_buffer { @buffer = (); }
>
>
>__END__
>
>
>что называется, quick and dirty, но как пример сойдет
- STDOUT/STDERR обработать через функцию, andy, 11:20 , 05-Июл-07 (6)
опять же не совсем понял. Некая функция должна перехватывать и обрабатывать строку непосредственно после её вывода? Ну тогда немного по другому сделаем:#!/usr/bin/perl
use strict;
use warnings;
sub output_processor; tie *STDOUT, 'OUT', \&output_processor;
#
# лишний код для записи в файл писать неохота, у меня функция-обработчик
# будет писать результат в STDERR
#tie *STDERR, 'OUT', \&output_processor; print "qwe";
warn "oops";
print "asd"; #untie *STDERR;
untie *STDOUT; print "test line\n"; sub output_processor {
print STDERR "res: $_[0]\n";
} #######################################################
package OUT;
our $processor_func; sub TIEHANDLE {
( my $self, $processor_func ) = @_;
bless {}, $self;
}
sub UNTIE {}
sub PRINT { $processor_func->( $_[1] ); } __END__ если опять неправильно понял, то обозначьте задачу поточнее, поточнее будет и решение
>Спасибо, andy!
>Но не совсем полностью, что хотелось бы. В примере получается, что вывод будет осуществлен только после исполнения print_array( OUT->get_buffer ); Нужно другое - вывод срезу, после появления print или warn
- STDOUT/STDERR обработать через функцию, jr, 11:45 , 05-Июл-07 (7)
Да, это то, что нужно, andy!
Спасибо огромное, давно хотел узнать, как такое можно реализовать!Единственное, возник сразу же последующий вопрос.
В данном примере STDOUT обрабатывается функцией output_processor и отравляется в STDERR. А как его (поток STDOUT) обработать и передать опять же в STDOUT, если так можно выразиться? Т.е. не перенаправлять STDOUT куда-то, а сделать что-то типа фильтра для него (фильтр в примере - это добавка "res: \n"). >опять же не совсем понял. Некая функция должна перехватывать и обрабатывать строку
>непосредственно после её вывода? Ну тогда немного по другому сделаем:
>
>#!/usr/bin/perl
>use strict;
>use warnings;
>sub output_processor;
>
>tie *STDOUT, 'OUT', \&output_processor;
>#
># лишний код для записи в файл писать неохота, у меня функция-обработчик
>
># будет писать результат в STDERR
>#tie *STDERR, 'OUT', \&output_processor;
>
>print "qwe";
>warn "oops";
>print "asd";
>
>#untie *STDERR;
>untie *STDOUT;
>
>print "test line\n";
>
>sub output_processor {
> print STDERR "res: $_[0]\n";
>}
>
>#######################################################
>package OUT;
>our $processor_func;
>
>sub TIEHANDLE {
> ( my $self, $processor_func ) = @_;
> bless {}, $self;
>}
>sub UNTIE {}
>sub PRINT { $processor_func->( $_[1] ); }
>
>__END__
>
>если опять неправильно понял, то обозначьте задачу поточнее, поточнее будет и решение
>
>
>
- STDOUT/STDERR обработать через функцию, andy, 11:57 , 05-Июл-07 (8)
а вот это вопрос... Я такого никогда не делал. Т.е. в ранешних версиях перла можно было просто написать
*REAL_STDOUT = STDOUT;
tie *STDOUT, 'OUT'
print REAL_STDOUT "Это неотфильтрованныя строка";сейчас такое не прокатывает. Мне сейчас некогда, я попозже примерчик напишу, ок? Заинтересовало. >Единственное, возник сразу же последующий вопрос.
>В данном примере STDOUT обрабатывается функцией output_processor и отравляется в STDERR. А
>как его (поток STDOUT) обработать и передать опять же в STDOUT,
>если так можно выразиться? Т.е. не перенаправлять STDOUT куда-то, а сделать
>что-то типа фильтра для него (фильтр в примере - это добавка
>"res: \n").
- STDOUT/STDERR обработать через функцию, andy, 08:41 , 06-Июл-07 (9)
по-быстрому получилось вот так, но почему-то мне этот код не нравится...
"меня терзают смутные сомнения" (с)#!/usr/bin/perl
use strict;
use warnings;
sub output_processor; tie *STDOUT, 'OUT', \&output_processor; print "qwe";
warn "oops";
print "asd"; untie *STDOUT; print "test line\n"; sub output_processor {
my $obj = tied *STDOUT;
untie *STDOUT;
print "res: $_[0]\n";
tie *STDOUT, $obj->get_name, \&{ (caller(0))[3] };
} #######################################################
package OUT;
our( $classname, $processor_func ); sub TIEHANDLE {
( $classname, $processor_func ) = @_;
bless {};
}
sub UNTIE {}
sub PRINT { $processor_func->( $_[1] ); }
sub get_name { return $classname; }
- STDOUT/STDERR обработать через функцию, jr, 10:33 , 06-Июл-07 (10)
Ок. Спасибо!>по-быстрому получилось вот так, но почему-то мне этот код не нравится...
>"меня терзают смутные сомнения" (с)
>
>
>
>#!/usr/bin/perl
>use strict;
>use warnings;
>sub output_processor;
>
>tie *STDOUT, 'OUT', \&output_processor;
>
>print "qwe";
>warn "oops";
>print "asd";
>
>untie *STDOUT;
>
>print "test line\n";
>
>sub output_processor {
> my $obj = tied *STDOUT;
> untie *STDOUT;
> print "res: $_[0]\n";
> tie *STDOUT, $obj->get_name, \&{ (caller(0))[3] };
>}
>
>#######################################################
>package OUT;
>our( $classname, $processor_func );
>
>sub TIEHANDLE {
> ( $classname, $processor_func ) = @_;
> bless {};
>}
>sub UNTIE {}
>sub PRINT { $processor_func->( $_[1] ); }
>sub get_name { return $classname; }
- STDOUT/STDERR обработать через функцию, andy, 11:00 , 06-Июл-07 (11)
что-то я действительно протупил. Как минимум имя класса, которому принадлежит объект, можно получить более правильно:sub output_processor {
my $classname = ref( tied *STDOUT );
untie *STDOUT;
print "res: $_[0]\n";
tie *STDOUT, $classname, \&{ (caller(0))[3] };
} тогда в OUT дурацкий метод get_name и переменная пакета $classname становятся не нужны.
- STDOUT/STDERR обработать через функцию, jr, 11:34 , 06-Июл-07 (12)
andy, спасибо огромное!
я понял, как все это работает! :)>что-то я действительно протупил. Как минимум имя класса, которому принадлежит объект, можно
>получить более правильно:
>
>sub output_processor {
> my $classname = ref( tied *STDOUT );
> untie *STDOUT;
> print "res: $_[0]\n";
> tie *STDOUT, $classname, \&{ (caller(0))[3] };
>}
>
>тогда в OUT дурацкий метод get_name и переменная пакета $classname становятся не
>нужны.
- STDOUT/STDERR обработать через функцию, NuINu, 12:31 , 06-Июл-07 (13)
>andy, спасибо огромное!
>я понял, как все это работает! :) я думаю, тебе не безинтересно будет посмотреть на тот код что я сварганил:
пакет MyLoger.pm
-------------------------
package MyLoger;
require Tie::Handle;
#use Data::Dumper; @ISA = qw(Tie::Handle); sub PRINT {
my $self = shift;
if( defined($self->{'LOGS'}) ) {
#print "Printed tie\n";
my @tmp = @{$self->{'LOGS'}};
#print Dumper(@tmp)."\n";
foreach my $fh ( @tmp ) {
print $fh @_;
}
}
} # Provide a needed method
sub TIEHANDLE {
my $class = shift;
my $self= {};
my $fh;
my @handles;
if(@_ >= 0) {
foreach my $namelog (@_) {
open($fh, $namelog);
push @handles, $fh;
undef $fh;
}
}
$self->{'LOGS'} = \@handles;
bless $self,$class;
return $self;
} # Overrides inherited method
sub UNTIE {
my $self = shift;
if( defined($self->{'LOGS'}) ) {
foreach my $fh (@{$self->{'LOGS'}}) {
close ($fh);
}
}
} # Provide a needed method 1;
------------------------- и тестовая программка :
#!/usr/bin/perl -w use strict;
use MyLoger;
use Data::Dumper;
print "test1\n";
print "test2\n";
print "test3\n";
print "test4\n";
my $tie_logs = tie *STDOUT, 'MyLoger', ">&STDOUT",'>tie1.log', '>>tie2.log';
#print Dumper($tie_logs)."\n"; print "test11\n";
print "test21\n";
print "test31\n";
print "test41\n"; untie *STDOUT;
- STDOUT/STDERR обработать через функцию, jr, 12:58 , 06-Июл-07 (14)
да, не безинтересно! :)
я не знал до этого времени tie/untie функцию и с классами особо не работал
спасибо!>я думаю, тебе не безинтересно будет посмотреть на тот код что я
>сварганил:
>пакет MyLoger.pm
>-------------------------
>package MyLoger;
>require Tie::Handle;
>#use Data::Dumper;
>
>@ISA = qw(Tie::Handle);
>
>sub PRINT {
> my $self = shift;
> if( defined($self->{'LOGS'}) ) {
> #print "Printed tie\n";
> my @tmp = @{$self->{'LOGS'}};
> #print Dumper(@tmp)."\n";
> foreach my $fh ( @tmp ) {
> print $fh @_;
> }
> }
>}
># Provide a needed method
>
>
>sub TIEHANDLE {
> my $class = shift;
> my $self= {};
> my $fh;
> my @handles;
> if(@_ >= 0) {
> foreach my $namelog (@_) {
> open($fh, $namelog);
> push @handles, $fh;
> undef $fh;
> }
> }
> $self->{'LOGS'} = \@handles;
> bless $self,$class;
> return $self;
>} # Overrides inherited method
>
>sub UNTIE {
> my $self = shift;
> if( defined($self->{'LOGS'}) ) {
> foreach my $fh (@{$self->{'LOGS'}}) {
> close ($fh);
> }
> }
>}
># Provide a needed method
>
>1;
>-------------------------
>
>и тестовая программка :
>#!/usr/bin/perl -w
>
>use strict;
>use MyLoger;
>use Data::Dumper;
>
>
>print "test1\n";
>print "test2\n";
>print "test3\n";
>print "test4\n";
>
>my $tie_logs = tie *STDOUT, 'MyLoger', ">&STDOUT",'>tie1.log', '>>tie2.log';
>#print Dumper($tie_logs)."\n";
>
>print "test11\n";
>print "test21\n";
>print "test31\n";
>print "test41\n";
>
>untie *STDOUT;
- STDOUT/STDERR обработать через функцию, NuINu, 13:45 , 06-Июл-07 (15)
>да, не безинтересно! :)
>я не знал до этого времени tie/untie функцию и с классами особо
>не работал
>спасибо!
>
да я и сам не знал :)
это не нужно! т.к. суепер класс не используется.
>>require Tie::Handle;
>>#use Data::Dumper;
>>
>>@ISA = qw(Tie::Handle);
- STDOUT/STDERR обработать через функцию, NuINu, 10:00 , 05-Июл-07 (4)
>Есть скрипт perl, который что-то выводит в STDOUT и в STDERR через
>print. Нужно не меняя print обработать этот вывод через функцию и
>перенаправить его куда-нибудь в другое место.
>Как это сделать?
open(LOG, '>>', $month_logsfile) or die "Can't open log file $month_logsfile\n";
open(STDOUT, ">>&LOG");
open(STDERR, ">>&LOG");
- STDOUT/STDERR обработать через функцию, jr, 10:18 , 05-Июл-07 (5)
Нет, это не совсем то. Мне не нужно просто перенаправить вывод в файл. Мне нужно обработать вывод некоторой функцией и уже потом его перенаправить куда-нибудь.>
>open(LOG, '>>', $month_logsfile) or die "Can't open log file $month_logsfile\n";
>open(STDOUT, ">>&LOG");
>open(STDERR, ">>&LOG");
|
Версия для распечатки
STDOUT/STDERR обработать через функцию, 
