|
ru.cgi.perl
- RU.CGI.PERL ------------------------------------------------------------------
From : Max Martynov 2:5025/2.250 25 Nov 2000 00:01:18
To : Slava Samsonov
Subject : chat
--------------------------------------------------------------------------------
Slava Samsonov забацал письмишко к All ,а в нем вот что:
SS> Подскажите PLS, как написать Чат на перле? (Желательно с примером)
лови (меньше 100 сточек :)) (к сожалению не помню чьи копиpайты. нашел по
ссылке с пpефньюса)
=== Cut ===
#!/usr/bin/perl
$|++;
use strict;
use CGI qw(:standard escapeHTML);
use HTTP::Daemon;
use HTTP::Status;
use URI::Find;
## config
my $PORT = 42001; # at what port
my $TIMEOUT = 90; # number of quiet seconds before abort
my $CHAT_TIME_MAX = 300; # how long to keep old scrollback
my $CHAT_COUNT_MAX = 12; # how many messages max
my $NAME_MAX = 30; # how long can a name be
my $MESS_MAX = 120; # how long can a message be
## end config
my ($HOST) = $ENV{SERVER_NAME} =~ /(.*)/s; # untaint
my $d = do {
local($^W) = 0;
new HTTP::Daemon (LocalAddr => $HOST, LocalPort => $PORT, Reuse => 1)
};
my $url = "http://$HOST:$PORT";
print header;
# durn - no shortcuts for this! what was lincoln thinkin'? :)
print <<END;
<html><head><title>Chat with us!</title></head>
<frameset rows="75%,25%">
<frame src="$url/read10" name=read><frame src="$url/write" name=write>
</frameset></html>
END
exit 0 unless defined $d; # do we need to become the server?
defined(my $pid = fork) or die "Cannot fork: $!";
exit 0 if $pid; # I am the parent
close(STDOUT);
my @CHAT;
{
alarm($TIMEOUT); # (re-)set the deadman timer
my $c = $d->accept or redo; # $c is a connection
my $r = $c->get_request; # $r is a request
close $c, redo unless $r; # not sure why I need this
(my $code = $r->url->epath) =~ s{^/}{};
$c->send_basic_header;
$CGI::Q = new CGI $r->content;
print $c header; # start_html is inside switch
if (my ($secs) = $code =~ /read(\d+)/) {
print $c start_html(-head => ["<meta http-equiv=refresh content=$secs>"]);
print $c h1("Chat responses"), "Change update to";
print $c " ",a({-href => "$url/read$_"}, $_) for qw(1 2 5 10 15 30 60);
print $c " seconds", br;
shift @CHAT while @CHAT > $CHAT_COUNT_MAX or
@CHAT and $CHAT[0][0] < time - $CHAT_TIME_MAX;
print $c table( {-border => 0, -cellspacing => 0, -cellpadding=> 2 },
map { Tr(td([substr(localtime($_->[0]),11,8).' from '.
fix($_->[1]).':', fix($_->[2],1) ]))} @CHAT);
} elsif ($code =~ /write/) {
if (defined(my $name = param('name'))
and defined(my $message = param('message'))) { # we have input!
tr/\x00-\x1f//d for $name, $message; # remove nasties
$name = substr($name, 0, $NAME_MAX) if length $name > $NAME_MAX;
$message = substr($message, 0, $MESS_MAX) if length $message > $MESS_MAX;
push @CHAT, [time, $name, $message] if length $name and length $message;
}
print $c start_html, h1("Chat write");
print $c start_form(-action => "$url/write");
print $c textfield("name","[I must change my name]", $NAME_MAX),
submit("says:"), textfield("message", "", $MESS_MAX, $MESS_MAX, 1);
print $c end_form;
}
print $c end_html;
close $c;
redo;
}
sub fix { # HTML escape, plus find URIs if $_[1]
local $_ = shift; return escapeHTML($_) unless shift;
# use \001 as "shift out", "shift in", presume data doesn't have \001
find_uris($_, sub {my ($uri, $text) = @_;
qq{\1<a href="\1$uri\1 "target=_blank>\1$text\1</a>\1} });
s/\G(.*?)(?:\001(.*?)\001)?/escapeHTML($1).(defined $2 ? $2 :"")/eig;
$_;
}
=== Cut ===
--- Д= CrazyMax =Дщ-= // UCLabs // CodeWise =-щ-= DeCoDeR BBS =-
* Origin: Hас было семеро - я и моя шестерка.; Воронеж, Русь. (2:5025/2.250)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
| Тема: |
Автор: |
Дата: |
|
chat |
Slava Samsonov |
24 Nov 2000 01:40:29 |
 chat |
Max Martynov |
25 Nov 2000 00:01:18 |
 Re: chat |
Michael Poliakov |
28 Nov 2000 15:01:58 |
|
|
