#!/usr/bin/perl
#
# Empire - A multi-player, client/server Internet based war game.
# Copyright (C) 1986-2020, Dave Pare, Jeff Bailey, Thomas Ruschak,
# Ken Stevens, Steve McClure, Markus Armbruster
#
# Empire is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see
\n"; next line; } if ($a[1] eq "SY") { @a = checkarg(1, @a); $a[2] = htmlify($a[2]); print "[##:##] Command : $a[2]
\n";
next line;
}
if ($a[1] eq "EX") {
my $str = htmlify(join(' ',@a[2..$#a]));
print "
[##:##] Command : $str
\n";
next line;
}
if ($a[1] eq "L" && $is_subj) {
$a[2] =~ / /;
print "
" . anchor("$`") . " $'\n";
next line;
}
if ($a[1] =~ /^LV?$/) {
@a = checkarg(1, @a);
$a[2] = htmlify($a[2]);
print "
\n"; next line; } if ($a[1] eq "eo") { $esc = 0; next line; } if ($a[1] eq "ec") { $esc = $#a == 1 ? "\\" : $a[2]; next line; } if ($a[1] =~ /NF|nf/i) { $in_nf = 1; printf (("
\n")); next line; } if ($a[1] =~ /FI|fi/i) { $in_nf = 0; printf (("
\n")); next line; } if ($a[1] eq "s1") { printf (("
\n")); next line; }
if ($a[1] eq "br") { printf "
\n"; next line; }
if ($a[1] eq "SA") {
@a = checkarg(1, @a);
@a = split(/[\: \"\,\.]+/, $a[2]);
for my $a (@a) {
$a = anchor($a);
}
print "
See also : ", join("\n, ", @a), "\n"; } # ignore unknown request } print "\n"; print "\n"; sub req { local ($_) = @_; if (/^([\.\'])[ \t]*([^ ]*) *(.*)/) { my @a = ($1, $2); $_ = $3; while (/\G(\"((\\.|[^\\\"])*)(\"|\Z))|\G(([^ ]|\\.)+) */g) { push(@a, $2 || $5); } return @a; } return (); } sub checkarg { my ($n, @a) = @_; warn "extra arguments for $a[1] ignored" if $#a > $n+1; warn "missing arguments for $a[1] supplied" if $#a < $n+1; while ($#a < $n+1) { push @a, ""; } return @a; } sub anchor { local ($_) = @_; return $topic{$_} ? "$_" : $_; } # Translate HTML special characters into escape sequences sub htmlify { local ($_) = @_; die "funny escape character `$esc' not supported" if $esc && $esc ne "\\"; # translate some troff escapes s/\\&//g if $esc; # zero width space character # escape HTML special characters s/\&/&/g; s/\</g; s/\>/>/g; return $_ unless $esc; # translate more troff escapes s/\\e/&\#92;/g; # escape character # turn quoted strings that look like info names into links # tacky... my $pfx = ""; while (/\\\*Q([A-Za-z0-9\-\.]+)\\\*U|\"info ([A-Za-z0-9\-\.]+)\"/) { if (defined $1 && $topic{$1}) { $pfx = $` . anchor($1); } elsif (defined $2 && $topic{$2}) { $pfx = "$`\"info " . anchor($2) . "\""; } else { $pfx .= $` . $&; } $_ = "$'"; } $_ = "$pfx$_"; # tranlate more troff escapes and strings s/\\\*Q//g; s/\\\*U/<\/em>/g; s/\\fI//g; s/\\fR/<\/em><\/em>/g; s/\\fB//g; s/\\fP/<\/strong><\/em>/g; s/\\\*\(bF//g; # bold font s/\\\*\(pF/<\/strong><\/em>/g; # pica font s/\\\*\(nF/<\/strong><\/em>/g; # normal font s/\\\*\(iF//g; # italic font s/\\\(mu/x/g; # multiply symbol s/\\ / /g; # non breaking space return $_; }