|
ru.perl
- RU.PERL ----------------------------------------------------------------------
From : Andrey Sapozhnikov 2:5020/400 15 May 2003 19:52:33
To : Ivan Frolcov
Subject : Re: Еще один вопрос... бинарные данные в переменной.
--------------------------------------------------------------------------------
Ivan Frolcov wrote:
> Wed May 14 2003 20:21, Nikolay Panov wrote to Elias Sergueeff:
>
> NP> Вот когда в перле не хватает нормальных двунаправленных пайпов...
>
> А сокеты на что?
Сокеты много сложнее чем просто пайпы. А вот почему человеку два
однонаправленых пайпа недостаточно - неясно. Главная загвоздка
не в количестве пайпов и их направленности, а в том, что для
реализации двустороннего обмена с программой-фильтром необходимо
реализовать механизм неблокирущих чтения и записи. Однако при
некотором знании вопроса и это несложно. Вполне можно сделать
некую универсальную запускалку фильтров вызывающую из себя
функции-обработчики событий готовности чтения данных фильтром
и готовности данных на выходе фильтра. Я написал некоторый
примерчик специально для этого:
use strict;
use IO::Select;
use Symbol;
use IPC::Open3;
use Errno qw(EINTR);
use POSIX ":sys_wait_h";
use Fcntl;
sub run_filter {
my $reader = shift;
my $writer = shift;
my $writer_err = shift;
my $wh = gensym;
my $rh = gensym;
my $eh = gensym;
my $pid = eval { open3($wh, $rh, $eh, @_) } or return;
fcntl($wh, F_SETFL, O_NONBLOCK) if $wh;
fcntl($rh, F_SETFL, O_NONBLOCK) if $rh;
fcntl($eh, F_SETFL, O_NONBLOCK) if $eh;
my $exited;
my $returned;
my $writebuf = '';
my $rpos = 0;
my $wpos = 0;
my $epos = 0;
local $SIG{PIPE} = 'IGNORE';
while ($rh || $eh || ($wh && !$exited)) {
my $writers = IO::Select->new;
my $readers = IO::Select->new;
$writers->add($wh) if $wh;
$readers->add($rh) if $rh;
$readers->add($eh) if $eh;
my ($ready4read, $ready4write) =
IO::Select::select($readers, $writers, undef);
if (!$ready4read) {
die unless $!{EINTR};
$exited = 1, undef $wh if waitpid($pid, WNOHANG) > 0;
$returned = $?;
next;
}
if (@$ready4write) {
unless (length ($writebuf)) {
$writebuf = $reader->($rpos);
$rpos += length($writebuf) if defined($writebuf);
}
if (defined($writebuf) && length($writebuf)) {
my $n = syswrite($wh, $writebuf);
if ($n) {
substr($writebuf, 0, $n, '');
} elsif ($!{EPIPE}) {
close $wh;
undef $wh;
undef $writebuf;
} elsif (!($!{EAGAIN} || $!{EINTR})) {
die;
}
} elsif (!defined($writebuf)) {
close $wh;
undef $wh;
}
}
foreach my $fh (@$ready4read) {
my $buf;
my $n = sysread($fh, $buf, 4096);
if (defined $n) {
if ($fh == $rh) {
close $rh, undef $rh unless
$writer->($wpos, $buf) && $n;
$wpos += $n;
} else {
close $eh, undef $eh unless
$writer_err->($epos, $buf) && $n;
$epos += $n;
}
} elsif (!($!{EAGAIN} || $!{EINTR})) {
die;
}
}
}
close $wh if $wh;
while (!$exited) {
my $n = waitpid($pid, 0);
if ($n > 0) {
$exited = 1;
$returned = $?;
} elsif (!$n || !$!{EINTR}) {
$exited = 1;
$returned = -1;
}
}
return $returned;
}
# --------------------------------
run_filter (
sub {
my $pos = shift;
return $pos > 100000 ? undef : 'x' x 10000;
},
sub {
print $_[1];
1;
},
sub {
print "ERROR: $_[1]\n";
1;
},
'cat'
);
--
Андрей
P.S. Желающие могут пооптимизировать код, особенно в части
где каждый раз перегенерируются объекты типа IO::Select.
Это немного накладно (если вам предстоит прокачивать через
фильтры гигабайты).
--- ifmail v.2.15dev5
* Origin: Demos online service (2:5020/400)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
