#!/usr/bin/perl
use warnings;
use strict;
use constant {
LOGFILE => "/tmp/klasse11-relay.log",
ME => "http://m19s28.vlinux.de/cgi-bin/klasse11-chat-show.pl",
LAST_N => 15,
REFRESH => 45,
};
sub qh($);
use CGI;
use CGI::Carp "fatalsToBrowser";
use Tie::File;
my $q = CGI->new;
print $q->header(
-refresh => join("; ", REFRESH, ME),
-type => "text/html; charset=UTF-8",
);
print <<TMPL;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<title>Chatterbox</title>
<link rel="stylesheet" href="http://m19s28.vlinux.de/iblech/klasse11/styles/screen.css">
<meta http-equiv="Refresh" content="${\ REFRESH}; URL=${\ ME}">
<script type="text/javascript">
<!--
function scrolldown (a) {
a.scrollBy(0, 10000);
}
-->
</script>
</head>
<body class="chatterbox" onload="scrolldown(this)">
<p class="chatterbox">
TMPL
tie my @log, "Tie::File", LOGFILE or die "Konnte nicht tie()en: $!\n";
local $_;
print " " . msg2html($_) . "<br>\n" for
reverse grep defined($_), (reverse @log)[0 .. LAST_N];
print <<TMPL;
</p>
</body>
</html>
TMPL
exit;
sub msg2html {
my $msg = shift;
if(my ($nick, $text) = $msg =~ /^([^ ]+): (.+)$/) {
$text = qh $text;
$text =~ s/(\Q**announcing**\E|WICHTIG|HEINZ)/<strong class="important">$1<\/strong>/ig;
return sprintf
"<span class=\"msgline\">" .
"<strong class=\"nick\">%s</strong>: " .
"<span class=\"message\">%s</span></span>",
qh $nick, $text;
} else {
return sprintf
"<span class=\"infoline\">%s</span>",
qh $msg;
}
}
sub qh($) {
my $str = shift;
my %subst = (
'&' => "&",
'<' => "<",
'>' => ">",
'"' => """,
# http://www.w3.org/TR/xhtml1/#C_13
# The named character reference ' (the apostrophe, U+0027) was
# introduced in XML 1.0 but does not appear in HTML. Authors should therefore
# use ' instead of ' to work as expected in HTML 4 user agents.
"'" => "'",
);
my $new = "";
while(length $str) {
my $char = substr $str, 0, 1, "";
$new .= defined $subst{$char} ? $subst{$char} : $char;
}
return $new;
}
Download