2016-12-17 12 views
3

ОК, так что я новичок в Perl и Perl 6. Я думал, что посмотрю, смогу ли я работать на нем и работать с трубами, но до сих пор невозможно. Вот мой Perl 6 Код:Код NativeCall для использования проксинга и трубопроводов Posix не работает

use NativeCall; 

# http://www.perlmonks.org/?node_id=989766 
our sub c_close(int32) returns int32 is native is symbol('close') { * } 
sub pipe(CArray[int32]) returns int32 is native { ... } 
our sub c_read(int32, Str is encoded('utf8'), size_t) returns ssize_t is native is symbol('read') { *} 
our sub c_write(int32, Str is encoded('utf8'), size_t) returns ssize_t is native is symbol('write') { *} 
our sub c_wait(int32 is rw) is native is symbol('wait') { * } 
sub c_puts(Str) is native is symbol("puts") { * } 
sub waitpid(int32, Pointer, int32) returns int32 is native {*}; 

my @fd := CArray[int32].new; 
#my ($child, $parent); 
my $pok = pipe(@fd); 
if ($pok == -1) { die "Pipe failed" ; } 

sub fork() returns int32 is native { ... }; 

# See: 
# https://rosettacode.org/wiki/Fork#Perl_6 
my $pid = fork(); 
if ($pid < 0) { die "Fork failed" ; } 
if ($pid == 0) { 
     print "C: I am the child\n"; 
     if (c_close(@fd[1]) == -1) { die "Child couldn't close fd[1]" }; 
     my $msg_in = ""; 
     say "C: starting read"; 
     my $nread = c_read(@fd[0], $msg_in, 80); 
     print "C: nread=$nread\n"; 
     print "C: message:$msg_in.\n"; 
     c_close(@fd[0]); 
} else { 
     print "P: I am the parent of $pid\n"; 
     if (c_close(@fd[0]) == -1) { die "Parent couldn't close fd[0]"; } ; 
     my $msg = "Hello from parent"; 
     my $len = $msg.encode('utf8').bytes + 1; 
     print "P: test put string: "; 
     c_puts($msg); 
     #print "P: len=$len\n"; 
     my $nwritten =c_write(@fd[1], $msg, $len); 
     print "P: len $len, wrote $nwritten\n"; 
     say "P: Finished writing"; 
     c_close(@fd[1]); 
     #my $null= 0; 
     #c_wait($null); 
     my $stat_loc; 
     waitpid($pid, $stat_loc ,0); 
} 

Это результат работы его:

P: I am the parent of 25809 
C: I am the child 
C: starting read 
C: nread=-1 
C: message:. 
P: test put string: Hello from parent 
P: len 18, wrote -1 
P: Finished writing 

кажется, что функция c_read() не блокирует по какой-то причине, что AFAIK невозможно. Не то чтобы я много знал о разветвлении.

Любые идеи, что такое исправление?

Ответ

Update 19-Dec-2016

Благодаря @timotimo, я был в состоянии получить рабочий раствор. Кажется, мои усилия могут быть улучшены. Например, я не думаю, что это нормально работает с UTF-8. Anyhoo, по крайней мере, «это работает».

use NativeCall; 

# http://www.perlmonks.org/?node_id=989766 
our sub c_close(int32) returns int32 is native is symbol('close') { * } 
our sub c_fork() returns int32 is native is symbol('fork') { ... }; 
our sub c_pipe(CArray[int32]) returns int32 is native is symbol('pipe') { ... } 
our sub c_puts(Str) is native is symbol("puts") { * } 
our sub c_read(int32, CArray[uint8], size_t) returns ssize_t is native is symbol('read') { *} 
our sub c_wait(int32 is rw) is native is symbol('wait') { * } 
our sub c_waitpid(int32, Pointer, int32) returns int32 is native is symbol('waitpid') {*}; 
our sub c_write(int32, Str is encoded('utf8'), size_t) returns ssize_t is native is symbol('write') { *} 


my @fd := CArray[int32].new(0, 0); 
my $pok = c_pipe(@fd); 
if ($pok == -1) { die "Pipe failed" ; } 


# See: 
# https://rosettacode.org/wiki/Fork#Perl_6 
my $pid = c_fork(); 
if ($pid < 0) { die "Fork failed" ; } 
if ($pid == 0) { 
     print "C: I am the child\n"; 
     if (c_close(@fd[1]) == -1) { die "Child couldn't close fd[1]" }; 
     my uint8 $b0 = 0; 
     my @buf := CArray[uint8].new($b0 xx 80); 
     say "C: starting read"; 
     my $nread = c_read(@fd[0], @buf, 80); 
     print "C: nread=$nread\n"; 
     my $msg = ""; 
     for (0..$nread-1) -> $i { $msg = $msg ~ chr(@buf[$i]); } ; 
     print "C: message:$msg.\n"; 
     c_close(@fd[0]); 
} else { 
     print "P: I am the parent of $pid\n"; 
     if (c_close(@fd[0]) == -1) { die "Parent couldn't close fd[0]"; } ; 
     my $msg = "Hello from parent"; 
     my $len = $msg.encode('utf8').bytes; 
     print "P: test put string: "; 
     c_puts($msg); 
     my $nwritten =c_write(@fd[1], $msg, $len); 
     print "P: len $len, wrote $nwritten\n"; 
     say "P: Finished writing"; 
     c_close(@fd[1]); 
     my $stat_loc; 
     c_waitpid($pid, $stat_loc ,0); 
} 

с выходом в настоящее время, как и ожидалось:

P: I am the parent of 22448 
C: I am the child 
P: test put string: Hello from parent 
C: starting read 
P: len 17, wrote 17 
P: Finished writing 
C: nread=17 
C: message:Hello from parent. 

Я создал gist, пересмотрев решение в зависимости от обстоятельств.

ответ

8

Ваша проблема была где-то совсем другим.

Вы создали CArray, но на самом деле вы не создали пространство для двух ints, которые хочет написать труба. Запись вошла в who-know-where, и ваш @fd имел только содержимое [0, 0], поэтому вы получали BADF (дескриптор Bad File Descriptor) на своих чтениях и записи, и поэтому они сразу же вернулись.

strace -f - блестящий инструмент, когда вы работаете с материалом posix api. это то, что дало мне правильную идею.

Вот код, который нужно сделать @fd работу вещь:

my @fd := CArray[int32].new(0, 0); 
pipe made 
here's the pipe fds 
17 
18 
P: I am the parent of 13943 
C: I am the child 
C: starting read 
P: test put string: Hello from parent 
P: len 18, wrote 18 
P: Finished writing 
C: nread=18 
C: message:. 

PS: Сообщение не записывается в должным образом, потому что аргумент Str в c_read не работает, как вы ожидаете это к. Вам нужно будет снова сделать то же самое с CArray, придать ему нужный размер (либо назначив 0 xx $size, либо сделав @result[$size + 1] = 0), а затем вам придется декодировать его как utf8 или latin1 или что-то-вы.