ecserver.pl 源代碼

- 中國WEB開發者網絡 (http://www.webasp.net)
-- 技術教程 (http://www.webasp.net/article/)
--- ecserver.pl 源代碼 (http://www.webasp.net/article/8/7777.htm)

-- 作者：未知
-- 發佈日期： 2003-09-13

下面的代碼有用到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; # 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></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;
}

webasp.net