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-2013, 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-FILE]
  35 #
  36 # Convert INFO-FILE (or else standard input) to HTML on standard output.
  37
  38 use strict;
  39 use warnings;
  40
  41 my $in_nf = 0;
  42 my $esc = "\\";
  43 my $ignore = 0;
  44 my $is_subj;
  45 my @a;
  46
  47 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"\n";
  48 print "   \"http://www.w3.org/TR/html4/strict.dtd\">\n";
  49 print "<html>\n";
  50 print "<head>\n";
  51
  52 line: while (<>) {
  53     chomp;                      # strip record separator
  54     s/((^|[^\\])(\\\\)*)\\\".*/$1/g; # strip comments
  55
  56     @a = req($_);
  57
  58     if (!@a) {
  59         if ($is_subj && $in_nf) {
  60             while ($_ =~ /[A-Za-z0-9\-\.]+/g) {
  61                 print htmlify("$`");
  62                 print anchor("$&");
  63                 $_="$'";
  64             }
  65         }
  66         print htmlify($_), "\n" unless $ignore;
  67         next line;
  68     }
  69
  70     # requests
  71
  72     if ($a[1] eq "ig") { $ignore = 1; next line; }
  73     if ($ignore) {
  74         $ignore = 0 if $a[1] eq "..";
  75         next line;
  76     }
  77
  78     if ($a[1] eq "TH") {
  79         @a = checkarg(2, @a);
  80         $is_subj = $a[2] eq 'Subject' || $a[2] eq 'Info';
  81         $a[3] = htmlify($a[3]);
  82         print "<title>$a[2] : $a[3]</title>\n";
  83         print "</head>\n";
  84         print "<body>\n";
  85         print "<h1>$a[2] : $a[3]</h1>\n";
  86         print "<p>\n";
  87         next line;
  88     }
  89
  90     if ($a[1] eq "SY") {
  91         @a = checkarg(1, @a);
  92         $a[2] = htmlify($a[2]);
  93         print "<samp>[##:##] Command : </samp><KBD>$a[2]</KBD><p>\n";
  94         next line;
  95     }
  96
  97     if ($a[1] eq "EX") {
  98         my $str = htmlify(join(' ',@a[2..$#a]));
  99         print "<br><samp>[##:##] Command : </samp><kbd>$str</kbd><p>\n";
 100         next line;
 101     }
 102
 103     if ($a[1] eq "L" && $is_subj) {
 104         $a[2] =~ / /;
 105         print "<br>" . anchor("$`") . " $'\n";
 106         next line;
 107     }
 108
 109     if ($a[1] =~ /^LV?$/) {
 110         @a = checkarg(1, @a);
 111         $a[2] = htmlify($a[2]);
 112         print "<h2>$a[2]</h2>\n";
 113         print "<p>\n";
 114         next line;
 115     }
 116
 117     if ($a[1] eq "eo") { $esc = 0; next line; }
 118     if ($a[1] eq "ec") { $esc = $#a == 1 ? "\\" : $a[2]; next line; }
 119
 120     if ($a[1] =~ /NF|nf/i) { $in_nf = 1; printf (("<p><pre>\n")); next line; }
 121     if ($a[1] =~ /FI|fi/i) { $in_nf = 0; printf (("</pre><p>\n")); next line; }
 122     if ($a[1] eq "s1") { printf (("<hr><p>\n")); next line; }
 123     if ($a[1] eq "br") { printf "<br>\n"; next line; }
 124
 125     if ($a[1] eq "SA") {
 126         @a = checkarg(1, @a);
 127         @a = split(/[\: \"\,\.]+/, $a[2]);
 128         for my $a (@a) {
 129             $a = anchor($a);
 130         }
 131         print "<p>See also : ", join("\n, ", @a), "\n";
 132     }
 133
 134     # ignore unknown request
 135 }
 136
 137 print "</body>\n";
 138 print "</html>\n";
 139
 140 sub req {
 141     local ($_) = @_;
 142     if (/^([\.\'])[ \t]*([^ ]*) *(.*)/) {
 143         my @a = ($1, $2);
 144         $_ = $3;
 145         while (/\G(\"((\\.|[^\\\"])*)(\"|\Z))|\G(([^ ]|\\.)+) */g) {
 146             push(@a, $2 || $5);
 147         }
 148         return @a;
 149     }
 150     return ();
 151 }
 152
 153 sub checkarg {
 154     my ($n, @a) = @_;
 155     warn "extra arguments for $a[1] ignored" if $#a > $n+1;
 156     warn "missing arguments for $a[1] supplied" if $#a < $n+1;
 157     while ($#a < $n+1) {
 158         push @a, "";
 159     }
 160     return @a;
 161 }
 162
 163 sub anchor {
 164     local ($_) = @_;
 165     # FIXME don't create dangling links here
 166     return "<a href=\"$_.html\">$_</a>";
 167 }
 168
 169 # Translate HTML special characters into escape sequences
 170 sub htmlify {
 171     local ($_) = @_;
 172     die "funny escape character `$esc' not supported"
 173         if $esc && $esc ne "\\";
 174     # translate some troff escapes
 175     s/\\&//g if $esc;           # zero width space character
 176     # escape HTML special characters
 177     s/\&/&amp;/g;
 178     s/\</&lt;/g;
 179     s/\>/&gt;/g;
 180     return $_ unless $esc;
 181     # translate more troff escapes
 182     s/\\e/&\#92;/g;             # escape character
 183     # turn quoted strings that look like info names into links
 184     # tacky...
 185     while (/(\\\*Q)([A-Za-z0-9\-\.]+)(\\\*U)/) {
 186         $_ = $` . anchor($2) . "$'";
 187     }
 188     while (/(\"info )([A-Za-z0-9\-\.]+)/) {
 189         $_ = "$`\"info " . anchor($2) . "$'";
 190     }
 191     # tranlate more troff escapes and strings
 192     s/\\\*Q/<em>/g;
 193     s/\\\*U/<\/em>/g;
 194     s/\\fI/<em>/g;
 195     s/\\fR/<\/em><\/em>/g;
 196     s/\\fB/<strong>/g;
 197     s/\\fP/<\/strong><\/em>/g;
 198     s/\\\*\(bF/<strong>/g;      # bold font
 199     s/\\\*\(pF/<\/strong><\/em>/g; # pica font
 200     s/\\\*\(nF/<\/strong><\/em>/g; # normal font
 201     s/\\\*\(iF/<em>/g;          # italic font
 202     s/\\\(mu/x/g;               # multiply symbol
 203     s/\\ /&nbsp;/g;             # non breaking space
 204     return $_;
 205 }