Xpoint
   [напомнить пароль]

tie STDOUT

Метки: [без меток]
2008-04-10 10:34:44 [обр] Михаил(3/17)[досье]

Вот тут решил написать небольшой модуль для себя, который бы перехватывал всё что идет в STDOUP стандартным print, и перенаправляет в переменную, а по запросу возвращает то что он отловил.
В принципе, такая же функциональность реализована в CGI::WebIn, но его функционал мне показался избыточным, и немного неудобным для моих целей. Посему и был написал этот маленький модуль.
Высставляют на ваше обозрение. И интересно услышать, какие проблемы у меня не учтены?

package Mymods::myout;

use Exporter;
@ISA = ('Exporter');
@EXPORT = qw(&stGrab &endGrab &getGrab);

my $buf;
sub output_processor;
sub stGrab ()
{   
   $buf = '';
   tie *STDOUT, 'MY_MODS_OUT', \&output_processor;
}

sub endGrab ()
{
   untie *STDOUT;   
}

sub getGrab ()
{
   return $buf;
}

sub output_processor {
  $buf .= $_[0];  
}

#######################################################
package MY_MODS_OUT;
our $processor_func;

sub TIEHANDLE {
  ( my $self, $processor_func ) = @_;
  bless {}, $self;
}
sub UNTIE {}
sub PRINT { $processor_func->( $_[1] ); }

1;

ПС: почти всё взято с форума опеннета.

спустя 41 минуту [обр] Алексей Севрюков(61/1292)[досье]

Михаил[досье]

print 1, 2, 3;

что у Вас покажет?

спустя 9 минут [обр] Михаил(3/17)[досье]

Алексей Севрюков[досье]
Уже исправляю. Щас выложу исправленную версию.
...
Вот:

package Mymods::myout;

use Exporter;
@ISA = ('Exporter');
@EXPORT = qw(&stGrab &endGrab &getGrab);

our $buf; 
sub output_processor;
sub stGrab ()
{   
   $buf = '';
   tie *STDOUT, 'MY_MODS_OUT', \&output_processor;
}

sub endGrab ()
{
   untie *STDOUT;   
}

sub getGrab ()
{
   return $buf;
}

sub output_processor {
  $buf .= join ('', @_);  
}

#######################################################
package MY_MODS_OUT;
our $processor_func;

sub TIEHANDLE {
  ( my $self, $processor_func ) = @_;
  bless {}, $self;
}
sub UNTIE {}
sub PRINT { shift; $processor_func->( @_ ); }
sub PRINTF { shift; @_ = sprintf(@_); $processor_func->( @_ );  }
sub CLOSE {$_[0]->parentCall( sub { close(*STDOUT) } ); }
sub BINMODE {$_[0]->parentCall( sub { binmode(*STDOUT) } );}
sub FILENO {$_[0]->parentCall( sub { return fileno(*STDOUT) } );} 

sub parentCall
{
   my ($this, $sub) = @_;
   my $save = tied(*STDOUT);   
   if ($save)
   {
      untie(*STDOUT);
      my @result = eval { wantarray? $sub->() : scalar $sub->() };
      tie *STDOUT, 'MY_MODS_OUT', $processor_func;
      return wantarray? @result : $result[0];
   }
}

Плюс никак чтот неприду к тому, как решить проблему с close STDOUT, чтобы он при этом сбрасывал в STDOUT то что накопил.

спустя 4 минуты [обр] Михаил(3/17)[досье]
Вот и сам решил вродебы проблему с close STDOUT:
sub CLOSE {$_[0]->parentCall( sub { print Mymods::myout::getGrab(); } );$_[0]->parentCall( sub { close(*STDOUT) } ); }
спустя 36 минут [обр] Михаил(3/17)[досье]
И ещё такой вопрос, какая функция в mod_perl вызывается, в пакете, при завершении скрипта, воктором подключается этот пакет?
Если без мод_перл, то DESTROY, а вот с mod_perl, что-то неполучается такое.
спустя 1 день 6 часов [обр] Green(0/6)[досье]
  1. В mod_perl скрипт не завершается
  2. В mod_perl DESTROY работает абсолютно так же, как и в обычном.
Видимо Ваше затруднение связано с первым пунктом
спустя 2 дня 14 часов [обр] Михаил(3/17)[досье]
Green[досье]
Я знаю что в mod_perl скрипт не завершается. В том собственнои состоит вопрос, вызывается ли какая либо ф-ия в mod_perl по завершении одной итерации скрипта, или по другому говоря, по завершении ф-ии в которую "обернут" написанный код?
Powered by POEM™ Engine Copyright © 2002-2005