#!/usr/local/bin/perl use strict; use warnings; my $esc="\\"; my @a; line: while (<>) { chomp; # strip record separator s/([^\\](\\\\)*)\\\".*/$1/g; # strip comments @a = req($_); if (!@a) { print htmlify($_), "\n"; next line; } # requests if ($a[1] eq "TH") { @a = checkarg(2, @a); $a[3] = htmlify($a[3]); print "$a[2] : $a[3]

$a[2] : $a[3]

\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] =~ /^LV?$/) { @a = checkarg(1, @a); $a[2] = htmlify($a[2]); print "

$a[2]

\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) { printf (("

\n")); next line; }
    if ($a[1] =~ /FI|fi/i) { 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 } sub req { local ($_) = @_; if (/^([\.\'])[ \t]*([^ ]+) *(.*)/) { my @a = ($1, $2); $_ = $3; while (/(\"((\\.|[^\\\"])*)(\"|\Z))|(([^ ]|\\.)+) */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 ($_) = @_; # FIXME don't create dangling links here return "$_"; } # 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; return $_ unless $esc; # translate more troff escapes s/\\e/&\#92;/g; # escape character # turn quoted strings that look like info names into links # tacky... while (/(\\\*Q)([A-Za-z0-9\-\.]+)(\\\*U)/) { $_ = $` . anchor($2) . "$'"; } while (/(\"info )([A-Za-z0-9\-\.]+)/) { $_ = "$`\"info " . anchor($2) . "$'"; } # 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 $_; }