http://wiki.crossplatform.ru/index.php?title=Perl/FAQ/%D0%A3%D0%BF%D1%80%D0%B0%D0%B2%D0%BB%D0%B5%D0%BD%D0%B8%D0%B5_%D0%B8_%D0%B2%D0%B7%D0%B0%D0%B8%D0%BC%D0%BE%D0%B4%D0%B5%D0%B9%D1%81%D1%82%D0%B2%D0%B8%D0%B5_%D1%81_%D0%BF%D1%80%D0%BE%D1%86%D0%B5%D1%81%D1%81%D0%B0%D0%BC%D0%B8&feed=atom&action=history
Perl/FAQ/Управление и взаимодействие с процессами - История изменений
2024-03-28T15:38:10Z
История изменений этой страницы в вики
MediaWiki 1.15.1
http://wiki.crossplatform.ru/index.php?title=Perl/FAQ/%D0%A3%D0%BF%D1%80%D0%B0%D0%B2%D0%BB%D0%B5%D0%BD%D0%B8%D0%B5_%D0%B8_%D0%B2%D0%B7%D0%B0%D0%B8%D0%BC%D0%BE%D0%B4%D0%B5%D0%B9%D1%81%D1%82%D0%B2%D0%B8%D0%B5_%D1%81_%D0%BF%D1%80%D0%BE%D1%86%D0%B5%D1%81%D1%81%D0%B0%D0%BC%D0%B8&diff=3521&oldid=prev
Root: Новая: {{Perl_header}} == Gathering Output from a Program == <source lang="perl"> #----------------------------- $output = `program args`; # collect output into one multiline string @output ...
2008-12-03T13:00:14Z
<p>Новая: {{Perl_header}} == Gathering Output from a Program == <source lang="perl"> #----------------------------- $output = `program args`; # collect output into one multiline string @output ...</p>
<p><b>Новая страница</b></p><div>{{Perl_header}}<br />
<br />
== Gathering Output from a Program ==<br />
<source lang="perl"><br />
#-----------------------------<br />
$output = `program args`; # collect output into one multiline string<br />
@output = `program args`; # collect output into array, one line per element<br />
#-----------------------------<br />
<br />
open(README, "program args |") or die "Can't run program: $!\n";<br />
while(<README>) {<br />
<br />
$output .= $_;<br />
}<br />
close(README);<br />
#-----------------------------<br />
`fsck -y /dev/rsd1a`; # BAD AND SCARY<br />
#-----------------------------<br />
use POSIX qw(:sys_wait_h);<br />
<br />
pipe(README, WRITEME);<br />
if ($pid = fork) {<br />
# parent<br />
<br />
$SIG{CHLD} = sub { 1 while ( waitpid(-1, WNOHANG)) > 0 };<br />
<br />
close(WRITEME);<br />
} else {<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
# child<br />
open(STDOUT, ">&=WRITEME") or die "Couldn't redirect STDOUT: $!";<br />
close(README);<br />
<br />
exec($program, $arg1, $arg2) or die "Couldn't run $program : $!\n";<br />
}<br />
<br />
while (<README>) {<br />
<br />
$string .= $_;<br />
# or push(@strings, $_);<br />
}<br />
close(README);<br />
#-----------------------------<br />
<br />
</source><br />
== Running Another Program ==<br />
<source lang="perl"><br />
#-----------------------------<br />
<br />
$status = system("vi $myfile");<br />
#-----------------------------<br />
$status = system("vi", $myfile);<br />
#-----------------------------<br />
system("cmd1 args | cmd2 | cmd3 >outfile");<br />
<br />
system("cmd args <infile >outfile 2>errfile");<br />
#-----------------------------<br />
$status = system($program, $arg1, $arg);<br />
die "$program exited funny: $?" unless $status == 0;<br />
<br />
#-----------------------------<br />
if (($signo = system(@arglist)) &= 127) { <br />
<br />
die "program killed by signal $signo\n";<br />
}<br />
#-----------------------------<br />
if ($pid = fork) {<br />
<br />
# parent catches INT and berates user<br />
local $SIG{INT} = sub { print "Tsk tsk, no process interruptus\n" };<br />
<br />
waitpid($pid, 0);<br />
} else {<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
# child ignores INT and does its thing<br />
$SIG{INT} = "IGNORE";<br />
exec("summarize", "/etc/logfiles") or die "Can't exec: $!\n";<br />
<br />
}<br />
#-----------------------------<br />
$shell = '/bin/tcsh';<br />
system $shell '-csh'; # pretend it's a login shell<br />
#-----------------------------<br />
system {'/bin/tcsh'} '-csh'; # pretend it's a login shell<br />
#-----------------------------<br />
# call expn as vrfy<br />
<br />
system {'/home/tchrist/scripts/expn'} 'vrfy', @ADDRESSES;<br />
#-----------------------------<br />
@args = ( "echo surprise" );<br />
<br />
system @args; # subject to shell escapes if @args == 1<br />
system { $args[0] } @args; # safe even with one-arg list<br />
#-----------------------------<br />
<br />
<br />
</source><br />
== Replacing the Current Program with a Different One ==<br />
<source lang="perl"><br />
#-----------------------------<br />
exec("archive *.data")<br />
or die "Couldn't replace myself with archive: $!\n";<br />
#-----------------------------<br />
exec("archive", "accounting.data")<br />
<br />
or die "Couldn't replace myself with archive: $!\n";<br />
#-----------------------------<br />
exec("archive accounting.data")<br />
or die "Couldn't replace myself with archive: $!\n";<br />
<br />
#-----------------------------<br />
<br />
</source><br />
== Reading or Writing to Another Program ==<br />
<source lang="perl"><br />
#-----------------------------<br />
$pid = open(README, "program arguments |") or die "Couldn't fork: $!\n";<br />
<br />
while (<README>) {<br />
# ...<br />
}<br />
close(README) or die "Couldn't close: $!\n";<br />
<br />
#-----------------------------<br />
$pid = open(WRITEME, "| program arguments") or die "Couldn't fork: $!\n";<br />
print WRITEME "data\n";<br />
<br />
close(WRITEME) or die "Couldn't close: $!\n";<br />
#-----------------------------<br />
$pid = open(F, "sleep 100000|"); # child goes to sleep<br />
<br />
close(F); # and the parent goes to lala land<br />
#-----------------------------<br />
$pid = open(WRITEME, "| program args");<br />
print WRITEME "hello\n"; # program will get hello\n on STDIN<br />
<br />
close(WRITEME); # program will get EOF on STDIN<br />
#-----------------------------<br />
$pager = $ENV{PAGER} || '/usr/bin/less'; # XXX: might not exist<br />
<br />
open(STDOUT, "| $pager");<br />
#-----------------------------<br />
<br />
</source><br />
== Filtering Your Own Output ==<br />
<source lang="perl"><br />
#-----------------------------<br />
head(100);<br />
while (<>) {<br />
<br />
print;<br />
} <br />
<br />
sub head {<br />
my $lines = shift || 20;<br />
<br />
return if $pid = open(STDOUT, "|-");<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
while (<STDIN>) {<br />
print;<br />
last unless --$lines ;<br />
<br />
} <br />
exit;<br />
} <br />
#-----------------------------<br />
1: > Welcome to Linux, version 2.0.33 on a i686<br />
<br />
<br />
2: > <br />
<br />
3: > "The software required `Windows 95 or better', <br />
<br />
4: > so I installed Linux." <br />
<br />
#-----------------------------<br />
> 1: Welcome to Linux, Kernel version 2.0.33 on a i686<br />
<br />
> 2: <br />
<br />
> 3: "The software required `Windows 95 or better', <br />
<br />
> 4: so I installed Linux." <br />
#-----------------------------<br />
# download the following standalone program<br />
#!/usr/bin/perl<br />
# qnumcat - demo additive output filters<br />
<br />
number(); # push number filter on STDOUT<br />
quote(); # push quote filter on STDOUT<br />
<br />
<br />
while (<>) { # act like /bin/cat<br />
print;<br />
} <br />
<br />
close STDOUT; # tell kids we're done--politely<br />
exit;<br />
<br />
sub number {<br />
my $pid;<br />
<br />
return if $pid = open(STDOUT, "|-");<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
while (<STDIN>) { printf "%d: %s", $., $_ } <br />
<br />
exit;<br />
} <br />
<br />
sub quote {<br />
my $pid;<br />
<br />
return if $pid = open(STDOUT, "|-");<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
while (<STDIN>) { print "> $_" } <br />
<br />
exit;<br />
} <br />
<br />
#-----------------------------<br />
<br />
</source><br />
== Preprocessing Input ==<br />
<source lang="perl"><br />
#-----------------------------<br />
@ARGV = map { /\.(gz|Z)$/ ? "gzip -dc $_ |" : $_ } @ARGV;<br />
<br />
while (<>) {<br />
# .......<br />
} <br />
#-----------------------------<br />
@ARGV = map { m#^\w+://# ? "GET $_ |" : $_ } @ARGV;<br />
<br />
while (<>) {<br />
# .......<br />
} <br />
#-----------------------------<br />
$pwdinfo = `domainname` =~ /^(\(none\))?$/<br />
? '< /etc/passwd'<br />
<br />
: 'ypcat passwd |';<br />
<br />
open(PWD, $pwdinfo) or die "can't open $pwdinfo: $!";<br />
<br />
#-----------------------------<br />
print "File, please? ";<br />
chomp($file = <>);<br />
open (FH, $file) or die "can't open $file: $!";<br />
<br />
#-----------------------------<br />
<br />
</source><br />
== Reading STDERR from a Program ==<br />
<source lang="perl"><br />
#-----------------------------<br />
$output = `cmd 2>&1`; # with backticks<br />
# or<br />
$pid = open(PH, "cmd 2>&1 |"); # with an open pipe<br />
<br />
while (<PH>) { } # plus a read<br />
#-----------------------------<br />
$output = `cmd 2>/dev/null`; # with backticks<br />
# or<br />
<br />
$pid = open(PH, "cmd 2>/dev/null |"); # with an open pipe<br />
while (<PH>) { } # plus a read<br />
#-----------------------------<br />
<br />
$output = `cmd 2>&1 1>/dev/null`; # with backticks<br />
# or<br />
$pid = open(PH, "cmd 2>&1 1>/dev/null |"); # with an open pipe<br />
<br />
while (<PH>) { } # plus a read<br />
#-----------------------------<br />
$output = `cmd 3>&1 1>&2 2>&3 3>&-`; # with backticks<br />
# or<br />
<br />
$pid = open(PH, "cmd 3>&1 1>&2 2>&3 3>&-|"); # with an open pipe<br />
while (<PH>) { } # plus a read<br />
#-----------------------------<br />
<br />
system("program args 1>/tmp/program.stdout 2>/tmp/program.stderr");<br />
#-----------------------------<br />
$output = `cmd 3>&1 1>&2 2>&3 3>&-`; <br />
<br />
#-----------------------------<br />
$fd3 = $fd1;<br />
$fd1 = $fd2;<br />
$fd2 = $fd3;<br />
$fd3 = undef;<br />
#-----------------------------<br />
system("prog args 1>tmpfile 2>&1");<br />
<br />
system("prog args 2>&1 1>tmpfile");<br />
#-----------------------------<br />
# system ("prog args 1>tmpfile 2>&1");<br />
$fd1 = "tmpfile"; # change stdout destination first<br />
<br />
$fd2 = $fd1; # now point stderr there, too<br />
#-----------------------------<br />
# system("prog args 2>&1 1>tmpfile");<br />
$fd2 = $fd1; # stderr same destination as stdout<br />
$fd1 = "tmpfile"; # but change stdout destination <br />
<br />
#-----------------------------<br />
<br />
</source><br />
== Controlling Input and Output of Another Program ==<br />
<source lang="perl"><br />
#-----------------------------<br />
use IPC::Open2;<br />
<br />
open2(*README, *WRITEME, $program);<br />
print WRITEME "here's your input\n";<br />
<br />
$output = <README>;<br />
close(WRITEME);<br />
close(README);<br />
#-----------------------------<br />
open(DOUBLE_HANDLE, "| program args |") # WRONG<br />
#-----------------------------<br />
<br />
use IPC::Open2;<br />
use IO::Handle;<br />
<br />
($reader, $writer) = (IO::Handle->new, IO::Handle->new);<br />
<br />
open2($reader, $writer, $program);<br />
#-----------------------------<br />
eval {<br />
open2($readme, $writeme, @program_and_arguments);<br />
<br />
};<br />
if ($@) { <br />
if ($@ =~ /^open2/) {<br />
<br />
warn "open2 failed: $!\n$@\n";<br />
return;<br />
}<br />
die; # reraise unforeseen exception<br />
<br />
}<br />
#-----------------------------<br />
<br />
</source><br />
== Controlling the Input, Output, and Error of Another Program ==<br />
<source lang="perl"><br />
#-----------------------------<br />
@all = `($cmd | sed -e 's/^/stdout: /' ) 2>&1`;<br />
for (@all) { push @{ s/stdout: // ? \@outlines : \@errlines }, $_ }<br />
<br />
print "STDOUT:\n", @outlines, "\n";<br />
print "STDERR:\n", @errlines, "\n";<br />
<br />
#-----------------------------<br />
open3(*WRITEHANDLE, *READHANDLE, *ERRHANDLE, "program to run");<br />
#-----------------------------<br />
use IPC::Open3;<br />
$pid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $cmd);<br />
<br />
close(HIS_IN); # give end of file to kid, or feed him<br />
@outlines = <HIS_OUT>; # read till EOF<br />
@errlines = <HIS_ERR>; # XXX: block potential if massive<br />
<br />
print "STDOUT:\n", @outlines, "\n";<br />
print "STDERR:\n", @errlines, "\n";<br />
<br />
#-----------------------------<br />
# download the following standalone program<br />
#!/usr/bin/perl<br />
# cmd3sel - control all three of kids in, out, and error.<br />
use IPC::Open3;<br />
use IO::Select;<br />
<br />
$cmd = "grep vt33 /none/such - /etc/termcap";<br />
<br />
$pid = open3(*CMD_IN, *CMD_OUT, *CMD_ERR, $cmd);<br />
<br />
$SIG{CHLD} = sub {<br />
print "REAPER: status $? on $pid\n" if waitpid($pid, 0) > 0<br />
<br />
};<br />
<br />
print CMD_IN "This line has a vt33 lurking in it\n";<br />
close(CMD_IN);<br />
<br />
$selector = IO::Select->new();<br />
<br />
$selector->add(*CMD_ERR, *CMD_OUT);<br />
<br />
while (@ready = $selector->can_read) {<br />
<br />
foreach $fh (@ready) {<br />
if (fileno($fh) == fileno(CMD_ERR)) {print "STDERR: ", scalar <CMD_ERR>}<br />
<br />
else {print "STDOUT: ", scalar <CMD_OUT>}<br />
$selector->remove($fh) if eof($fh);<br />
<br />
}<br />
}<br />
<br />
close(CMD_CUT);<br />
close(CMD_ERR);<br />
<br />
#-----------------------------<br />
<br />
</source><br />
== Communicating Between Related Processes ==<br />
<source lang="perl"><br />
#-----------------------------<br />
pipe(READER, WRITER);<br />
if (fork) {<br />
# run parent code, either reading or writing, not both<br />
<br />
} else {<br />
# run child code, either reading or writing, not both<br />
}<br />
#-----------------------------<br />
if ($pid = open(CHILD, "|-")) {<br />
<br />
# run parent code, writing to child<br />
} else {<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
# otherwise run child code here, reading from parent<br />
}<br />
#-----------------------------<br />
if ($pid = open(CHILD, "-|")) {<br />
<br />
# run parent code, reading from child<br />
} else {<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
# otherwise run child code here, writing to parent<br />
}<br />
#-----------------------------<br />
# download the following standalone program<br />
#!/usr/bin/perl -w<br />
# pipe1 - use pipe and fork so parent can send to child<br />
<br />
use IO::Handle;<br />
pipe(READER, WRITER);<br />
<br />
WRITER->autoflush(1);<br />
<br />
if ($pid = fork) {<br />
close READER;<br />
<br />
print WRITER "Parent Pid $$ is sending this\n";<br />
close WRITER;<br />
waitpid($pid,0);<br />
<br />
} else {<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
close WRITER;<br />
chomp($line = <READER>);<br />
print "Child Pid $$ just read this: `$line'\n";<br />
<br />
close READER; # this will happen anyway<br />
exit;<br />
}<br />
<br />
#-----------------------------<br />
# download the following standalone program<br />
<br />
#!/usr/bin/perl -w<br />
# pipe2 - use pipe and fork so child can send to parent<br />
<br />
use IO::Handle;<br />
pipe(READER, WRITER);<br />
WRITER->autoflush(1);<br />
<br />
if ($pid = fork) {<br />
close WRITER;<br />
chomp($line = <READER>);<br />
<br />
print "Parent Pid $$ just read this: `$line'\n";<br />
close READER;<br />
waitpid($pid,0);<br />
<br />
} else {<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
close READER;<br />
print WRITER "Child Pid $$ is sending this\n";<br />
close WRITER; # this will happen anyway<br />
<br />
exit;<br />
}<br />
<br />
#-----------------------------<br />
# download the following standalone program<br />
#!/usr/bin/perl -w<br />
# pipe3 - use forking open so parent can send to child<br />
<br />
use IO::Handle;<br />
<br />
if ($pid = open(CHILD, "|-")) {<br />
CHILD->autoflush(1);<br />
<br />
print CHILD "Parent Pid $$ is sending this\n";<br />
close(CHILD);<br />
} else {<br />
<br />
die "cannot fork: $!" unless defined $pid;<br />
chomp($line = <STDIN>);<br />
<br />
print "Child Pid $$ just read this: `$line'\n";<br />
exit;<br />
}<br />
<br />
#-----------------------------<br />
# download the following standalone program<br />
#!/usr/bin/perl -w<br />
# pipe4 - use forking open so child can send to parent<br />
<br />
<br />
use IO::Handle;<br />
if ($pid = open(CHILD, "-|")) {<br />
<br />
chomp($line = <CHILD>);<br />
print "Parent Pid $$ just read this: `$line'\n";<br />
close(CHILD);<br />
<br />
} else {<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
STDOUT->autoflush(1);<br />
print STDOUT "Child Pid $$ is sending this\n";<br />
exit;<br />
<br />
}<br />
<br />
#-----------------------------<br />
# download the following standalone program<br />
#!/usr/bin/perl -w<br />
# pipe5 - bidirectional communication using two pipe pairs<br />
# designed for the socketpair-challenged<br />
use IO::Handle;<br />
pipe(PARENT_RDR, CHILD_WTR);<br />
<br />
pipe(CHILD_RDR, PARENT_WTR);<br />
CHILD_WTR->autoflush(1);<br />
PARENT_WTR->autoflush(1);<br />
<br />
if ($pid = fork) {<br />
close PARENT_RDR; close PARENT_WTR;<br />
<br />
print CHILD_WTR "Parent Pid $$ is sending this\n";<br />
chomp($line = <CHILD_RDR>);<br />
print "Parent Pid $$ just read this: `$line'\n";<br />
<br />
close CHILD_RDR; close CHILD_WTR;<br />
waitpid($pid,0);<br />
<br />
} else {<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
close CHILD_RDR; close CHILD_WTR;<br />
chomp($line = <PARENT_RDR>);<br />
<br />
print "Child Pid $$ just read this: `$line'\n";<br />
print PARENT_WTR "Child Pid $$ is sending this\n";<br />
close PARENT_RDR; close PARENT_WTR;<br />
<br />
exit;<br />
}<br />
<br />
#-----------------------------<br />
# download the following standalone program<br />
#!/usr/bin/perl -w<br />
# pipe6 - bidirectional communication using socketpair<br />
# "the best ones always go both ways"<br />
<br />
use Socket;<br />
<br />
use IO::Handle;<br />
# We say AF_UNIX because although *_LOCAL is the<br />
# POSIX 1003.1g form of the constant, many machines<br />
# still don't have it.<br />
socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)<br />
or die "socketpair: $!";<br />
<br />
CHILD->autoflush(1);<br />
PARENT->autoflush(1);<br />
<br />
if ($pid = fork) {<br />
<br />
close PARENT;<br />
print CHILD "Parent Pid $$ is sending this\n";<br />
chomp($line = <CHILD>);<br />
<br />
print "Parent Pid $$ just read this: `$line'\n";<br />
close CHILD;<br />
waitpid($pid,0);<br />
<br />
} else {<br />
die "cannot fork: $!" unless defined $pid;<br />
<br />
close CHILD;<br />
chomp($line = <PARENT>);<br />
print "Child Pid $$ just read this: `$line'\n";<br />
<br />
print PARENT "Child Pid $$ is sending this\n";<br />
close PARENT;<br />
exit;<br />
<br />
}<br />
<br />
#-----------------------------<br />
socketpair(READER, WRITER, AF_UNIX, SOCK_STREAM, PF_UNSPEC);<br />
shutdown(READER, 1); # no more writing for reader<br />
shutdown(WRITER, 0); # no more reading for writer<br />
#-----------------------------<br />
<br />
<br />
</source><br />
== Making a Process Look Like a File with Named Pipes ==<br />
<source lang="perl"><br />
#-----------------------------<br />
#% mkfifo /path/to/named.pipe<br />
#-----------------------------<br />
open(FIFO, "< /path/to/named.pipe") or die $!;<br />
while (<FIFO>) {<br />
<br />
print "Got: $_";<br />
}<br />
close(FIFO);<br />
#-----------------------------<br />
open(FIFO, "> /path/to/named.pipe") or die $!;<br />
<br />
print FIFO "Smoke this.\n";<br />
close(FIFO);<br />
#-----------------------------<br />
#% mkfifo ~/.plan # isn't this everywhere yet?<br />
#% mknod ~/.plan p # in case you don't have mkfifo<br />
#-----------------------------<br />
# download the following standalone program<br />
#!/usr/bin/perl -w<br />
# dateplan - place current date and time in .plan file<br />
while (1) {<br />
<br />
open(FIFO, "> $ENV{HOME}/.plan")<br />
or die "Couldn't open $ENV{HOME}/.plan for writing: $!\n";<br />
<br />
print FIFO "The current time is ", scalar(localtime), "\n";<br />
close FIFO;<br />
<br />
sleep 1;<br />
}<br />
<br />
#-----------------------------<br />
# download the following standalone program<br />
#!/usr/bin/perl -w<br />
# fifolog - read and record log msgs from fifo<br />
<br />
use IO::File;<br />
<br />
$SIG{ALRM} = sub { close(FIFO) }; # move on to the next queued process<br />
<br />
<br />
while (1) {<br />
alarm(0); # turn off alarm for blocking open<br />
open(FIFO, "< /tmp/log") or die "Can't open /tmp/log : $!\n";<br />
<br />
alarm(1); # you have 1 second to log<br />
<br />
$service = <FIFO>;<br />
next unless defined $service; # interrupted or nothing logged<br />
<br />
chomp $service;<br />
<br />
$message = <FIFO>;<br />
next unless defined $message; # interrupted or nothing logged<br />
<br />
chomp $message;<br />
<br />
alarm(0); # turn off alarms for message processing<br />
<br />
if ($service eq "http") {<br />
<br />
# ignoring<br />
} elsif ($service eq "login") {<br />
# log to /var/log/login<br />
<br />
if ( open(LOG, ">> /tmp/login") ) {<br />
print LOG scalar(localtime), " $service $message\n";<br />
<br />
close(LOG);<br />
} else {<br />
warn "Couldn't log $service $message to /var/log/login : $!\n";<br />
<br />
}<br />
}<br />
}<br />
<br />
#-----------------------------<br />
use POSIX qw(:errno_h);<br />
<br />
$SIG{PIPE} = 'IGNORE';<br />
# ...<br />
$status = print FIFO "Are you there?\n";<br />
<br />
if (!$status && $! == EPIPE) {<br />
warn "My reader has forsaken me!\n";<br />
next;<br />
<br />
}<br />
#-----------------------------<br />
use POSIX;<br />
print _POSIX_PIPE_BUF, "\n";<br />
#-----------------------------<br />
<br />
</source><br />
== Sharing Variables in Different Processes ==<br />
<source lang="perl"><br />
#-----------------------------<br />
# download the following standalone program<br />
<br />
#!/usr/bin/perl <br />
# sharetest - test shared variables across forks<br />
use IPC::Shareable;<br />
<br />
$handle = tie $buffer, 'IPC::Shareable', undef, { destroy => 1 };<br />
<br />
$SIG{INT} = sub { die "$$ dying\n" };<br />
<br />
for (1 .. 10) { <br />
unless ($child = fork) { # i'm the child<br />
<br />
die "cannot fork: $!" unless defined $child;<br />
squabble();<br />
exit;<br />
<br />
} <br />
push @kids, $child; # in case we care about their pids<br />
}<br />
<br />
while (1) {<br />
<br />
print "Buffer is $buffer\n";<br />
sleep 1;<br />
} <br />
die "Not reached";<br />
<br />
sub squabble {<br />
my $i = 0;<br />
while (1) { <br />
<br />
next if $buffer =~ /^$$\b/o; <br />
$handle->shlock();<br />
$i++;<br />
<br />
$buffer = "$$ $i";<br />
$handle->shunlock();<br />
}<br />
} <br />
<br />
#-----------------------------<br />
<br />
</source><br />
== Listing Available Signals ==<br />
<source lang="perl"><br />
#-----------------------------<br />
#% kill -l<br />
#HUP INT QUIT ILL TRAP ABRT BUS FPE KILL USR1 SEGV USR2 PIPE <br />
#<br />
#ALRM TERM CHLD CONT STOP TSTP TTIN TTOU URG XCPU XFSZ VTALRM <br />
#<br />
#PROF WINCH POLL PWR<br />
#-----------------------------<br />
#% perl -e 'print join(" ", keys %SIG), "\n"'<br />
#XCPU ILL QUIT STOP EMT ABRT BUS USR1 XFSZ TSTP INT IOT USR2 INFO TTOU<br />
#<br />
#ALRM KILL HUP URG PIPE CONT SEGV VTALRM PROF TRAP IO TERM WINCH CHLD<br />
#<br />
#FPE TTIN SYS<br />
#-----------------------------<br />
#% perl -MConfig -e 'print $Config{sig_name}'<br />
#ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM<br />
#<br />
#TERM URG STOP TSTP CONT CHLD TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH<br />
#<br />
#INFO USR1 USR2 IOT<br />
#-----------------------------<br />
<br />
use Config;<br />
defined $Config{sig_name} or die "No sigs?";<br />
<br />
$i = 0; # Config prepends fake 0 signal called "ZERO".<br />
foreach $name (split(' ', $Config{sig_name})) {<br />
<br />
$signo{$name} = $i;<br />
$signame[$i] = $name;<br />
<br />
$i++;<br />
}<br />
#-----------------------------<br />
<br />
</source><br />
== Sending a Signal ==<br />
<source lang="perl"><br />
#-----------------------------<br />
kill 9 => $pid; # send $pid a signal 9<br />
<br />
kill -1 => $pgrp; # send whole job a signal 1<br />
kill USR1 => $$; # send myself a SIGUSR1<br />
<br />
kill HUP => @pids; # send a SIGHUP to processes in @pids<br />
#-----------------------------<br />
use POSIX qw(:errno_h);<br />
<br />
if (kill 0 => $minion) {<br />
print "$minion is alive!\n";<br />
<br />
} elsif ($! == EPERM) { # changed uid<br />
print "$minion has escaped my control!\n";<br />
<br />
} elsif ($! == ESRCH) {<br />
print "$minion is deceased.\n"; # or zombied<br />
<br />
} else {<br />
warn "Odd; I couldn't check on the status of $minion: $!\n";<br />
}<br />
#-----------------------------<br />
<br />
</source><br />
== Installing a Signal Handler ==<br />
<source lang="perl"><br />
#-----------------------------<br />
<br />
$SIG{QUIT} = \&got_sig_quit; # call &got_sig_quit for every SIGQUIT <br />
$SIG{PIPE} = 'got_sig_pipe'; # call main::got_sig_pipe for every SIGPIPE <br />
<br />
$SIG{INT} = sub { $ouch++ }; # increment $ouch for every SIGINT<br />
#-----------------------------<br />
$SIG{INT} = 'IGNORE'; # ignore the signal INT<br />
#-----------------------------<br />
<br />
$SIG{STOP} = 'DEFAULT'; # restore default STOP signal handling<br />
#-----------------------------<br />
<br />
</source><br />
== Temporarily Overriding a Signal Handler ==<br />
<source lang="perl"><br />
#-----------------------------<br />
# the signal handler<br />
sub ding {<br />
<br />
$SIG{INT} = \&ding;<br />
warn "\aEnter your name!\n";<br />
}<br />
<br />
# prompt for name, overriding SIGINT<br />
sub get_name {<br />
local $SIG{INT} = \&ding;<br />
<br />
my $name;<br />
<br />
print "Kindly Stranger, please enter your name: ";<br />
chomp( $name = <> );<br />
<br />
return $name;<br />
}<br />
#-----------------------------<br />
<br />
</source><br />
== Writing a Signal Handler ==<br />
<source lang="perl"><br />
#-----------------------------<br />
$SIG{INT} = \&got_int;<br />
<br />
sub got_int {<br />
$SIG{INT} = \&got_int; # but not for SIGCHLD!<br />
<br />
# ...<br />
}<br />
#-----------------------------<br />
my $interrupted = 0;<br />
<br />
sub got_int {<br />
<br />
$interrupted = 1;<br />
$SIG{INT} = 'DEFAULT'; # or 'IGNORE'<br />
die;<br />
<br />
}<br />
<br />
eval {<br />
$SIG{INT} = \&got_int;<br />
<br />
# ... long-running code that you don't want to restart<br />
};<br />
<br />
if ($interrupted) {<br />
# deal with the signal<br />
}<br />
<br />
#-----------------------------<br />
$SIG{INT} = \&catcher;<br />
sub catcher {<br />
$SIG{INT} = \&catcher;<br />
<br />
# ...<br />
}<br />
#-----------------------------<br />
use Config;<br />
print "Hurrah!\n" if $Config{d_sigaction};<br />
<br />
#-----------------------------<br />
#% egrep 'S[AV]_(RESTART|INTERRUPT)' /usr/include/*/signal.h<br />
#-----------------------------<br />
<br />
</source><br />
== Catching Ctrl-C ==<br />
<source lang="perl"><br />
#-----------------------------<br />
$SIG{INT} = 'IGNORE';<br />
#-----------------------------<br />
$SIG{INT} = \&tsktsk;<br />
<br />
sub tsktsk {<br />
$SIG{INT} = \&tsktsk; # See ``Writing A Signal Handler''<br />
<br />
warn "\aThe long habit of living indisposeth us for dying.\n";<br />
}<br />
#-----------------------------<br />
#% stty -a<br />
#speed 9600 baud; 38 rows; 80 columns;<br />
#<br />
#lflags: icanon isig iexten echo echoe -echok echoke -echonl echoctl<br />
#<br />
# -echoprt -altwerase -noflsh -tostop -flusho pendin -nokerninfo<br />
#<br />
# -extproc<br />
#<br />
#iflags: -istrip icrnl -inlcr -igncr ixon -ixoff ixany imaxbel -ignbrk<br />
#<br />
# brkint -inpck -ignpar -parmrk<br />
#<br />
#oflags: opost onlcr oxtabs<br />
#<br />
#cflags: cread cs8 -parenb -parodd hupcl -clocal -cstopb -crtscts -dsrflow<br />
#<br />
# -dtrflow -mdmbuf<br />
#<br />
#cchars: discard = ^O; dsusp = ^Y; eof = ^D; eol = <undef;><br />
#<br />
# eol2 = <undef; erase = ^H; intr = ^C; kill = ^U; lnext = ^V;><br />
#<br />
# min = 1; quit = ^\; reprint = ^R; start = ^Q; status = <undef;><br />
<br />
#<br />
# stop = ^S; susp = ^Z; time = 0; werase = ^W;<br />
#-----------------------------<br />
<br />
</source><br />
== Avoiding Zombie Processes ==<br />
<source lang="perl"><br />
#-----------------------------<br />
$SIG{CHLD} = 'IGNORE';<br />
#-----------------------------<br />
use POSIX ":sys_wait_h";<br />
<br />
$SIG{CHLD} = \&REAPER;<br />
sub REAPER {<br />
my $stiff;<br />
<br />
while (($stiff = waitpid(-1, &WNOHANG)) > 0) {<br />
<br />
# do something with $stiff if you want<br />
}<br />
$SIG{CHLD} = \&REAPER; # install *after* calling waitpid<br />
}<br />
<br />
#-----------------------------<br />
$exit_value = $? >> 8;<br />
$signal_num = $? & 127;<br />
$dumped_core = $? & 128;<br />
#-----------------------------<br />
<br />
use POSIX qw(:signal_h :errno_h :sys_wait_h);<br />
<br />
$SIG{CHLD} = \&REAPER;<br />
<br />
sub REAPER {<br />
my $pid;<br />
<br />
$pid = waitpid(-1, &WNOHANG);<br />
<br />
if ($pid == -1) {<br />
# no child waiting. Ignore it.<br />
} elsif (WIFEXITED($?)) {<br />
<br />
print "Process $pid exited.\n";<br />
} else {<br />
print "False alarm on $pid.\n";<br />
<br />
}<br />
$SIG{CHLD} = \&REAPER; # in case of unreliable signals<br />
}<br />
#-----------------------------<br />
<br />
use Config;<br />
$has_nonblocking = $Config{d_waitpid} eq "define" ||<br />
$Config{d_wait4} eq "define";<br />
<br />
#-----------------------------<br />
<br />
</source><br />
== Blocking Signals ==<br />
<source lang="perl"><br />
#-----------------------------<br />
use POSIX qw(:signal_h);<br />
<br />
$sigset = POSIX::SigSet->new(SIGINT); # define the signals to block<br />
<br />
$old_sigset = POSIX::SigSet->new; # where the old sigmask will be kept<br />
<br />
unless (defined sigprocmask(SIG_BLOCK, $sigset, $old_sigset)) {<br />
<br />
die "Could not block SIGINT\n";<br />
}<br />
#-----------------------------<br />
unless (defined sigprocmask(SIG_UNBLOCK, $old_sigset)) {<br />
<br />
die "Could not unblock SIGINT\n";<br />
}<br />
#-----------------------------<br />
use POSIX qw(:signal_h);<br />
<br />
$sigset = POSIX::SigSet->new( SIGINT, SIGKILL );<br />
#-----------------------------<br />
<br />
</source><br />
== Timing Out an Operation ==<br />
<source lang="perl"><br />
#-----------------------------<br />
$SIG{ALRM} = sub { die "timeout" };<br />
<br />
eval {<br />
alarm(3600);<br />
# long-time operations here<br />
alarm(0);<br />
<br />
};<br />
<br />
if ($@) {<br />
if ($@ =~ /timeout/) {<br />
<br />
# timed out; do what you will here<br />
} else {<br />
alarm(0); # clear the still-pending alarm<br />
die; # propagate unexpected exception<br />
<br />
} <br />
} <br />
#-----------------------------<br />
<br />
</source><br />
== Program: sigrand ==<br />
<source lang="perl"><br />
#-----------------------------<br />
#Make is like Pascal: everybody likes it, so they go in and change it.<br />
# --Dennis Ritchie<br />
#%%<br />
#I eschew embedded capital letters in names; to my prose-oriented eyes,<br />
#they are too awkward to read comfortably. They jangle like bad typography.<br />
# --Rob Pike<br />
#%%<br />
#God made the integers; all else is the work of Man. <br />
# --Kronecker<br />
#%%<br />
#I'd rather have :rofix than const. --Dennis Ritchie<br />
#%%<br />
#If you want to program in C, program in C. It's a nice language.<br />
#I use it occasionally... :-) --Larry Wall<br />
#%%<br />
#Twisted cleverness is my only skill as a programmer. <br />
# --Elizabeth Zwicky<br />
#%%<br />
#Basically, avoid comments. If your code needs a comment to be understood,<br />
#it would be better to rewrite it so it's easier to understand. <br />
<br />
# --Rob Pike<br />
#%%<br />
#Comments on data are usually much more helpful than on algorithms. <br />
# --Rob Pike<br />
#%% <br />
#Programs that write programs are the happiest programs in the world.<br />
# --Andrew Hume <br />
#%%<br />
#-----------------------------<br />
# download the following standalone program<br />
#!/usr/bin/perl -w<br />
# sigrand - supply random fortunes for .signature file<br />
<br />
use strict;<br />
<br />
# config section variables<br />
use vars qw( $NG_IS_DIR $MKNOD $FULLNAME $FIFO $ART $NEWS $SIGS $SEMA<br />
$GLOBRAND $NAME );<br />
<br />
# globals<br />
use vars qw( $Home $Fortune_Path @Pwd );<br />
<br />
################################################################<br />
# begin configuration section <br />
# should really read from ~/.sigrandrc<br />
<br />
gethome();<br />
<br />
# for rec/humor/funny instead of rec.humor.funny<br />
$NG_IS_DIR = 1; <br />
<br />
$MKNOD = "/bin/mknod";<br />
$FULLNAME = "$Home/.fullname";<br />
$FIFO = "$Home/.signature";<br />
$ART = "$Home/.article";<br />
$NEWS = "$Home/News";<br />
<br />
$SIGS = "$NEWS/SIGNATURES";<br />
$SEMA = "$Home/.sigrandpid";<br />
$GLOBRAND = 1/4; # chance to use global sigs anyway<br />
<br />
# $NAME should be (1) left undef to have program guess<br />
# read address for signature maybe looking in ~/.fullname,<br />
# (2) set to an exact address, or (3) set to empty string<br />
# to be omitted entirely.<br />
<br />
<br />
$NAME = ''; # means no name used<br />
## $NAME = "me\@home.org\n"; <br />
<br />
# end configuration section -- HOME and FORTUNE get autoconf'd<br />
################################################################<br />
<br />
setup(); # pull in inits<br />
<br />
justme(); # make sure program not already running<br />
fork && exit; # background ourself and go away<br />
<br />
open (SEMA, "> $SEMA") or die "can't write $SEMA: $!";<br />
<br />
print SEMA "$$\n";<br />
close(SEMA) or die "can't close $SEMA: $!";<br />
<br />
# now loop forever, writing a signature into the <br />
# fifo file. if you don't have real fifos, change<br />
# sleep time at bottom of loop to like 10 to update<br />
# only every 10 seconds.<br />
for (;;) {<br />
open (FIFO, "> $FIFO") or die "can't write $FIFO: $!";<br />
<br />
my $sig = pick_quote();<br />
for ($sig) { <br />
<br />
s/^((:?[^\n]*\n){4}).*$/$1/s; # trunc to 4 lines<br />
<br />
s/^(.{1,80}).*? *$/$1/gm; # trunc long lines<br />
}<br />
<br />
# print sig, with name if present, padded to four lines<br />
if ($NAME) { <br />
print FIFO $NAME, "\n" x (3 - ($sig =~ tr/\n//)), $sig;<br />
<br />
} else {<br />
print FIFO $sig;<br />
}<br />
close FIFO;<br />
<br />
# Without a microsleep, the reading process doesn't finish before<br />
# the writer tries to open it again, which since the reader exists,<br />
# succeeds. They end up with multiple signatures. Sleep a tiny bit<br />
# between opens to give readers a chance to finish reading and close<br />
# our pipe so we can block when opening it the next time.<br />
<br />
select(undef, undef, undef, 0.2); # sleep 1/5 second<br />
<br />
}<br />
die "XXX: NOT REACHED"; # you can't get here from anywhere<br />
<br />
################################################################<br />
<br />
# Ignore SIGPIPE in case someone opens us up and then closes the fifo<br />
# without reading it; look in a .fullname file for their login name.<br />
# Try to determine the fully qualified hostname. Look our for silly<br />
# ampersands in passwd entries. Make sure we have signatures or fortunes.<br />
# Build a fifo if we need to.<br />
<br />
sub setup {<br />
<br />
$SIG{PIPE} = 'IGNORE'; <br />
<br />
unless (defined $NAME) { # if $NAME undef in config<br />
<br />
if (-e $FULLNAME) {<br />
$NAME = `cat $FULLNAME`;<br />
die "$FULLNAME should contain only 1 line, aborting" <br />
<br />
if $NAME =~ tr/\n// > 1;<br />
} else {<br />
<br />
my($user, $host);<br />
chop($host = `hostname`);<br />
($host) = gethostbyname($host) unless $host =~ /\./;<br />
<br />
$user = $ENV{USER} || $ENV{LOGNAME} || $Pwd[0]<br />
<br />
or die "intruder alert";<br />
($NAME = $Pwd[6]) =~ s/,.*//;<br />
<br />
$NAME =~ s/&/\u\L$user/g; # can't believe some folks still do this<br />
$NAME = "\t$NAME\t$user\@$host\n";<br />
} <br />
<br />
}<br />
<br />
check_fortunes() if !-e $SIGS;<br />
<br />
unless (-p $FIFO) { # -p checks whether it's a named pipe<br />
if (!-e _) {<br />
<br />
system("$MKNOD $FIFO p") && die "can't mknod $FIFO";<br />
warn "created $FIFO as a named pipe\n";<br />
<br />
} else {<br />
die "$0: won't overwrite file .signature\n";<br />
} <br />
<br />
} else {<br />
warn "$0: using existing named pipe $FIFO\n";<br />
} <br />
<br />
# get a good random number seed. not needed if 5.004 or better.<br />
srand(time() ^ ($$ + ($$ << 15)));<br />
<br />
}<br />
<br />
# choose a random signature<br />
sub pick_quote {<br />
my $sigfile = signame();<br />
<br />
if (!-e $sigfile) {<br />
return fortune();<br />
<br />
} <br />
open (SIGS, "< $sigfile" ) or die "can't open $sigfile";<br />
<br />
local $/ = "%%\n";<br />
local $_;<br />
my $quip;<br />
<br />
rand($.) < 1 && ($quip = $_) while <SIGS>;<br />
<br />
close SIGS;<br />
chomp $quip;<br />
return $quip || "ENOSIG: This signature file is empty.\n";<br />
<br />
} <br />
<br />
# See whether ~/.article contains a Newsgroups line. if so, see the first<br />
# group posted to and find out whether it has a dedicated set of fortunes.<br />
# otherwise return the global one. also, return the global one randomly<br />
# now and then to spice up the sigs.<br />
sub signame {<br />
(rand(1.0) > ($GLOBRAND) && open ART) || return $SIGS; <br />
<br />
local $/ = '';<br />
local $_ = <ART>;<br />
my($ng) = /Newsgroups:\s*([^,\s]*)/;<br />
<br />
$ng =~ s!\.!/!g if $NG_IS_DIR; # if rn -/, or SAVEDIR=%p/%c<br />
$ng = "$NEWS/$ng/SIGNATURES";<br />
<br />
return -f $ng ? $ng : $SIGS;<br />
} <br />
<br />
# Call the fortune program with -s for short flag until<br />
# we get a small enough fortune or ask too much.<br />
sub fortune {<br />
<br />
local $_;<br />
my $tries = 0;<br />
do { <br />
<br />
$_ = `$Fortune_Path -s`; <br />
} until tr/\n// < 5 || $tries++ > 20;<br />
<br />
s/^/ /mg;<br />
$_ || " SIGRAND: deliver random signals to all processes.\n";<br />
} <br />
<br />
# Make sure there's a fortune program. Search <br />
<br />
# for its full path and set global to that.<br />
sub check_fortunes {<br />
return if $Fortune_Path; # already set<br />
for my $dir (split(/:/, $ENV{PATH}), '/usr/games') {<br />
<br />
return if -x ($Fortune_Path = "$dir/fortune");<br />
} <br />
<br />
die "Need either $SIGS or a fortune program, bailing out";<br />
} <br />
<br />
# figure out our directory<br />
sub gethome {<br />
<br />
@Pwd = getpwuid($<);<br />
$Home = $ENV{HOME} || $ENV{LOGDIR} || $Pwd[7]<br />
<br />
or die "no home directory for user $<";<br />
}<br />
<br />
# "There can be only one." --the Highlander<br />
sub justme {<br />
<br />
if (open SEMA) {<br />
my $pid;<br />
<br />
chop($pid = <SEMA>);<br />
kill(0, $pid) and die "$0 already running (pid $pid), bailing out";<br />
<br />
close SEMA;<br />
} <br />
} <br />
<br />
#-----------------------------<br />
<br />
</source><br />
<br />
{{Perl_Footer}}</div>
Root