運行這個代碼，你需要在相同目錄下面放一個文本文件chat.log
聊天內容將保存在這個文件內。代碼調用unix/linux處理log的function
寫入/讀取聊天內容。
至于多進程，好像socket自己就可以處理。。。那個listen()你自己看一下。
Perl我是幾乎什么都不懂的。所以只好您老人家自己研究了。：）
搞明白了別忘了教小弟幾招。
另外，nt平臺上可以用vc寫chatserver嘛。(這個我更不懂了)
#!/usr/bin/perl
# EveryChat Server Edition Beta 1
#
# This is beta code. You may not
# upload, post, mirror, share, sell
# or otherwise redistribute this
# code in full or in part without
# written permission from the
# author.
#
# By downloading this code, you
# are granted permission to use
# this code on a single server or
# physical machine provided you
# agree with this license agreement.
#
# This code is provided "AS-IS"
# without any warrantees or
# guarantees of any kind.
#
# This code is protected under US
# and international copyright laws.
#
# (c) 1999 EverySoft
# ALL RIGHTS RESERVED
$servername = 'http://';
$ARGV[0] ||= 'localhost';
$servername .= $ARGV[0];
$ARGV[1] ||= '8080';
$servername .= ":$ARGV[1]";
$ARGV[2] ||= './chat.log';
$ARGV[3] ||= 'EveryChat Server Edition';
$|=1;
use Socket;
use Carp;
use POSIX;
my $proto = getprotobyname('tcp');
socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($ARGV[1], INADDR_ANY)) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";
my $waitedpid = 0;
my $paddr;
$SIG{CHLD} = sub {wait();};
sub checksocket {
my $dummy;
undef $!;
$dummy=<STDIN>;
if (!(defined($dummy)) && !($!)) {
close TAIL;
die("Socket Closed...\n");
}
}
sub spawn {
my $coderef = shift;
my $pid;
if (!defined($pid = fork)) {
print "cannot fork: $!";
return;
} elsif ($pid) {
return; # I'm the parent
}
open(STDIN, "<&Client") || die "can't dup client to stdin";
open(STDOUT, ">&Client") || die "can't dup client to stdout";
exit &$coderef();
}
sub printlines {
open TAIL, "tail -f $ARGV[2] |";
while ($go == 1) {
print "<TABLE BGCOLOR=#EEEEEE CELLSPACING=2 CELLPADDING=3 BORDER=0 WIDTH=100%><TR><TD>" . <TAIL> . "</TD></TR></TABLE><SCRIPT Language=JavaScript1.2><!--\nself.scrollBy(0,640);\n//--></SCRIPT>\n";
&checksocket;
}
close TAIL;
}
sub getform {
$formstring = shift;
foreach $elem (split(/&|=/,$formstring)) {
$elem =~ tr/+/ /; # pluses become spaces
$elem =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
push @data, $elem;
}
%form=@data(%form=@data);
}
sub server {
$go=1;
while ($go && defined ($buf = <STDIN>)) {
if ($buf =~ /GET/) {
print "HTTP/1.1 200 OK\nServer: EveryChat/1.0.0 (Unix)\nConnection: close\nContent-Type: text/html\n\n";
if ($buf =~ /realtime/) {
print "<BODY BGCOLOR=#FFFFFF>\n";
print "<TABLE BGCOLOR=#EEEEEE CELLSPACING=2 CELLPADDING=3 BORDER=0 WIDTH=100%><TR><TD><FONT COLOR=#AA0000><B>Welcome to $ARGV[3]!</B></FONT></TD></TR></TABLE>\n";
fcntl(STDIN, F_SETFL(), O_NONBLOCK()) || die "Can't make socket nonblocking: $!\n";
&printlines;
}
elsif ($buf =~ /chatform/) {
print "<BODY BGCOLOR=#FFFFFF>
<FORM METHOD=GET ACTION=$servername/post><NOBR>
<CENTER>Name: <INPUT TYPE=TEXT NAME=name> <INPUT TYPE=HIDDEN NAME=login VALUE=1><INPUT TYPE=SUBMIT VALUE=Enter!></CENTER>
</NOBR></FORM></BODY>\n";
$go=0;
}
elsif ($buf =~ /post\?(\S+)/) {
&getform($1);
if ($form{'logout'}) {
print "<BODY BGCOLOR=#FFFFFF>
<CENTER>Thanks for visiting $ARGV[3]</CENTER>
</BODY>\n"
}
else {
print "<BODY BGCOLOR=#FFFFFF onLoad=\"document.msgform.message.focus();\">
<FORM METHOD=GET ACTION=$servername/post NAME=msgform><NOBR>
<CENTER><INPUT TYPE=HIDDEN NAME=name VALUE=\"$form{'name'}\">Message: <INPUT TYPE=TEXT NAME=message SIZE=40> <INPUT TYPE=SUBMIT VALUE=Post!> <INPUT TYPE=SUBMIT NAME=logout VALUE=Logout></CENTER>
</NOBR></FORM></BODY>\n";
}
$time = localtime(time);
open MESSAGES, ">>$ARGV[2]";
print MESSAGES "<FONT COLOR=#0000AA><B><$form{'name'}></B></FONT> $form{'message'}\n" if $form{'message'};
print MESSAGES "<FONT COLOR=#00AA00>*** <B>$form{'name'}</B> entered the room on $time</FONT>\n" if $form{'login'};
print MESSAGES "<FONT COLOR=#00AA00>*** <B>$form{'name'}</B> left the room on $time</FONT>\n" if $form{'logout'};
close MESSAGES;
$go=0;
}
else {
print "<FRAMESET ROWS=*,50>
<FRAME SRC=$servername/realtime SCROLLING=AUTO>
<FRAME SRC=$servername/chatform SCROLLING=NO>
</FRAMESET>\n";
$go=0;
}
}
}
}
for ( $waitedpid = 0; ($paddr = accept(Client,Server)) || $waitedpid; $waitedpid = 0, close Client) {
next if $waitedpid and not $paddr;
spawn \&server;
}
文章來源于領測軟件測試網 http://www.kjueaiud.com/
