git.pond.sub.org Git - empserver/blob - info/emp2html.pl

   1 #!/usr/bin/perl
   2 #
   3 #   Empire - A multi-player, client/server Internet based war game.
   4 #   Copyright (C) 1986-2020, Dave Pare, Jeff Bailey, Thomas Ruschak,
   5 #                 Ken Stevens, Steve McClure, Markus Armbruster
   6 #
   7 #   Empire is free software: you can redistribute it and/or modify
   8 #   it under the terms of the GNU General Public License as published by
   9 #   the Free Software Foundation, either version 3 of the License, or
  10 #   (at your option) any later version.
  11 #
  12 #   This program is distributed in the hope that it will be useful,
  13 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 #   GNU General Public License for more details.
  16 #
  17 #   You should have received a copy of the GNU General Public License
  18 #   along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19 #
  20 #   ---
  21 #
  22 #   See files README, COPYING and CREDITS in the root of the source
  23 #   tree for related information and legal notices.  It is expected
  24 #   that future projects/authors will amend these files as needed.
  25 #
  26 #   ---
  27 #
  28 #   emp2html.pl: Convert info source to HTML
  29 #
  30 #   Known contributors to this file:
  31 #      Drake Diedrich, 1996
  32 #      Markus Armbruster, 2004-2013
  33 #
  34 # Usage: emp2html.pl INFO...
  35 #
  36 # Convert info source on standard input to HTML on standard output.
  37 # INFO... are the info page names.
  38
  39 use strict;
  40 use warnings;
  41
  42 my $in_nf = 0;
  43 my $esc = "\\";
  44 my $ignore = 0;
  45 my $is_subj;
  46 my @a;
  47 my %topic;
  48
  49 for (@ARGV) {
  50     $topic{$_} = 1;
  51 }
  52
  53 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"\n";
  54 print "   \"http://www.w3.org/TR/html4/strict.dtd\">\n";
  55 print "<html>\n";
  56 print "<head>\n";
  57
  58 line: while (<STDIN>) {
  59     chomp;                      # strip record separator
  60     s/((^|[^\\])(\\\\)*)\\\".*/$1/g; # strip comments
  61
  62     @a = req($_);
  63
  64     if (!@a) {
  65         if ($is_subj && $in_nf) {
  66             while ($_ =~ /[A-Za-z0-9\-\.]+/g) {
  67                 print htmlify("$`");
  68                 print anchor("$&");
  69                 $_="$'";
  70             }
  71         }
  72         print htmlify($_), "\n" unless $ignore;
  73         next line;
  74     }
  75
  76     # requests
  77
  78     if ($a[1] eq "ig") { $ignore = 1; next line; }
  79     if ($ignore) {
  80         $ignore = 0 if $a[1] eq "..";
  81         next line;
  82     }
  83
  84     if ($a[1] eq "TH") {
  85         @a = checkarg(2, @a);
  86         $is_subj = $a[2] eq 'Subject' || $a[2] eq 'Info';
  87         $a[3] = htmlify($a[3]);
  88         print "<title>$a[2] : $a[3]</title>\n";
  89         print "</head>\n";
  90         print "<body>\n";
  91         print "<h1>$a[2] : $a[3]</h1>\n";
  92         print "<p>\n";
  93         next line;
  94     }
  95
  96     if ($a[1] eq "SY") {
  97         @a = checkarg(1, @a);
  98         $a[2] = htmlify($a[2]);
  99         print "<samp>[##:##] Command : </samp><KBD>$a[2]</KBD><p>\n";
 100         next line;
 101     }
 102
 103     if ($a[1] eq "EX") {
 104         my $str = htmlify(join(' ',@a[2..$#a]));
 105         print "<br><samp>[##:##] Command : </samp><kbd>$str</kbd><p>\n";
 106         next line;
 107     }
 108
 109     if ($a[1] eq "L" && $is_subj) {
 110         $a[2] =~ / /;
 111         print "<br>" . anchor("$`") . " $'\n";
 112         next line;
 113     }
 114
 115     if ($a[1] =~ /^LV?$/) {
 116         @a = checkarg(1, @a);
 117         $a[2] = htmlify($a[2]);
 118         print "<h2>$a[2]</h2>\n";
 119         print "<p>\n";
 120         next line;
 121     }
 122
 123     if ($a[1] eq "eo") { $esc = 0; next line; }
 124     if ($a[1] eq "ec") { $esc = $#a == 1 ? "\\" : $a[2]; next line; }
 125
 126     if ($a[1] =~ /NF|nf/i) { $in_nf = 1; printf (("<p><pre>\n")); next line; }
 127     if ($a[1] =~ /FI|fi/i) { $in_nf = 0; printf (("</pre><p>\n")); next line; }
 128     if ($a[1] eq "s1") { printf (("<hr><p>\n")); next line; }
 129     if ($a[1] eq "br") { printf "<br>\n"; next line; }
 130
 131     if ($a[1] eq "SA") {
 132         @a = checkarg(1, @a);
 133         @a = split(/[\: \"\,\.]+/, $a[2]);
 134         for my $a (@a) {
 135             $a = anchor($a);
 136         }
 137         print "<p>See also : ", join("\n, ", @a), "\n";
 138     }
 139
 140     # ignore unknown request
 141 }
 142
 143 print "</body>\n";
 144 print "</html>\n";
 145
 146 sub req {
 147     local ($_) = @_;
 148     if (/^([\.\'])[ \t]*([^ ]*) *(.*)/) {
 149         my @a = ($1, $2);
 150         $_ = $3;
 151         while (/\G(\"((\\.|[^\\\"])*)(\"|\Z))|\G(([^ ]|\\.)+) */g) {
 152             push(@a, $2 || $5);
 153         }
 154         return @a;
 155     }
 156     return ();
 157 }
 158
 159 sub checkarg {
 160     my ($n, @a) = @_;
 161     warn "extra arguments for $a[1] ignored" if $#a > $n+1;
 162     warn "missing arguments for $a[1] supplied" if $#a < $n+1;
 163     while ($#a < $n+1) {
 164         push @a, "";
 165     }
 166     return @a;
 167 }
 168
 169 sub anchor {
 170     local ($_) = @_;
 171     return $topic{$_} ? "<a href=\"$_.html\">$_</a>" : $_;
 172 }
 173
 174 # Translate HTML special characters into escape sequences
 175 sub htmlify {
 176     local ($_) = @_;
 177     die "funny escape character `$esc' not supported"
 178         if $esc && $esc ne "\\";
 179     # translate some troff escapes
 180     s/\\&//g if $esc;           # zero width space character
 181     # escape HTML special characters
 182     s/\&/&amp;/g;
 183     s/\</&lt;/g;
 184     s/\>/&gt;/g;
 185     return $_ unless $esc;
 186     # translate more troff escapes
 187     s/\\e/&\#92;/g;             # escape character
 188     # turn quoted strings that look like info names into links
 189     # tacky...
 190     my $pfx = "";
 191     while (/\\\*Q([A-Za-z0-9\-\.]+)\\\*U|\"info ([A-Za-z0-9\-\.]+)\"/) {
 192         if (defined $1 && $topic{$1}) {
 193             $pfx = $` . anchor($1);
 194         } elsif (defined $2 && $topic{$2}) {
 195             $pfx = "$`\"info " . anchor($2) . "\"";
 196         } else {
 197             $pfx .= $` . $&;
 198         }
 199         $_ = "$'";
 200     }
 201     $_ = "$pfx$_";
 202     # tranlate more troff escapes and strings
 203     s/\\\*Q/<em>/g;
 204     s/\\\*U/<\/em>/g;
 205     s/\\fI/<em>/g;
 206     s/\\fR/<\/em><\/em>/g;
 207     s/\\fB/<strong>/g;
 208     s/\\fP/<\/strong><\/em>/g;
 209     s/\\\*\(bF/<strong>/g;      # bold font
 210     s/\\\*\(pF/<\/strong><\/em>/g; # pica font
 211     s/\\\*\(nF/<\/strong><\/em>/g; # normal font
 212     s/\\\*\(iF/<em>/g;          # italic font
 213     s/\\\(mu/x/g;               # multiply symbol
 214     s/\\ /&nbsp;/g;             # non breaking space
 215     return $_;
 216 }