- 论坛徽章:
- 0
|
如果是长期要运行的话，建议写成daemon进程。那样可能会稳定些. 下面是个例子
#!/usr/bin/perl
use strict;
use IO::File;
use IO::Socket;
use Chatbot::Eliza;
use POSIX qw(WNOHANG setsid);
use constant PORT => 9000;
use constant PID_FILE => '/var/run/test.pid';
my $quit = 0;
$SIG{CHLD} = sub { while (waitpid(-1,WNOHANG)>0){}};
$SIG{TERM} = $SIG{INT} = sub { $quit++;};
my $fh = open_pid_file(PID_FILE);
my $listen_socket= IO::Socket::INET->new(LocalPort => shift || PORT,
Listen => 20,
Proto => 'tcp',
Reuse => 1,
Timeout => 60*60
);
die "Can not Create a listenling socket: $@" unless $listen_socket;
warn "$0 starting...\n";
my $pid = become_daemon();
print $fh $pid;
close($fh);
for(; {
if(my $connection = $listen_socket->accept){
if((my $child = fork()) == 0){
$listen_socket->close;
interact($connection);
exit(0);
}
$connection->close;
}
}
sub become_daemon(){
die "can't fork" unless defined ( my $child = fork );
exit 0 if $child;
setsid();
open(STDIN,"</dev/null";
open(STDOUT,">/dev/null";
open(STDERR,">&/dev/null";
chdir '/';
umask(0);
$ENV{PATH} = '/bin:/sbin:/usr/bin:/usr/sbin';
return $$;
}
sub open_pid_file(){
my $file = shift;
if( -e $file) {
my $fh = IO::File->new($file)||return;
my $pid=<$fh>;
die "Server already running with PID $pid" if kill 0 => $pid;
warn "Removing PID file for defunct server process $pid\n";
die "Can not unlink PID file $file" unless -w $file && unlink $file;
}
return IO::File->new($file,O_WRONLY|O_CREAT|O_EXCL,0644)
or die "Can not create $file: $!\n"
}
sub interact(){
my $sock = shift;
my $string;
#STDIN->fdopen($sock,"<" or die "Can not reopen STDIN: $!";
#STDOUT->fdopen($sock,">" or die "Can not reopen STDOUT: $!";
#STDERR->fdopen($sock,">" or die "Can not reopen STDERR: $!";
#$| = 1;
recv $sock,$string,1024,0;
send $sock,$string,0;
}
END {unlink PID_FILE if $$ == $pid;}
[ 本帖最后由 Perl_Er 于 2009-5-30 15:13 编辑 ] |
|
免费注册
楼主: gaochong
发表于 2009-05-30 09:41
