IDC资讯中心
下面的代码有用到unix/linux的系统功能所以不能在nt上使用。
运行这个代码，你需要在相同目录下面放一个文本文件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; # im the parent
}
open(stdin, "<&client") || die "cant dup client to stdin";
open(stdout, ">&client") || die "cant 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 "cant 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;
}
