#!/usr/bin/perl
use strict;
my($app_svnid) = '$HeadURL$ $LastChangedRevision$';
# Allow bare words, so &ade_err_error() calls look nicer.
no strict 'subs';
use lib substr `ade-config ade_include_prefix`,0,-1;
use ADE;
use Getopt::Long qw(:config no_ignore_case);
&ade_err_registerdefderrs({
ademan2html_err_internal => { fmt => "%s" },
});
# The 'dsc' field is only used in error messages relating to undefined stuff. Maybe
# if there was a config file keyword assigned then I could use that instead.
my($opt_fragment);
my(@ademanhtml_config_hasharray) = (
{ dsc => "opt_fragment", var => \$opt_fragment, dfl => 0 },
);
sub ademan2html
{
my($errstack_ref) = @_;
my($rc, $listpaths, $optval);
my(@buffer, $count, $mode, $c, $procopts_hashref);
##########################################################################
#
# Process options
#
##########################################################################
$procopts_hashref = {
"fragment" => \$opt_fragment
};
if (($rc=&ade_spc_procopts($errstack_ref, \&ademan2html_listpaths, \&ademan2html_usage, \&ademan2html_version, \@ademanhtml_config_hasharray, $procopts_hashref)) != $ade_err_ok) {
return($rc);
}
##########################################################################
#
# Process arguments
#
##########################################################################
(defined($ARGV[0])) && &ade_err_usage($errstack_ref, \&ademan2html_usage, 1);
##########################################################################
#
# Guts start here
#
##########################################################################
open(PIPE, "nroff -man|") || &ade_err_error($errstack_ref, "nroff: can't execute");
if (!$opt_fragment) {
print "\n";
print "\n";
}
if (($rc=&ade_spc_autogendheader($errstack_ref, \*STDOUT, "", undef)) != $ade_err_ok) {
close(PIPE);
return($rc);
}
print "\n";
for ($count=0,$mode="normal";defined($c = $buffer[$count++] = getc PIPE);) {
&ade_err_debug($errstack_ref, 10, "[READ:$c]");
if ($count == 1) {
if ($buffer[$count-1] eq " ") {
&ade_err_debug($errstack_ref, 10, "[1SP]");
&safeprint($errstack_ref, "$buffer[--$count]");
} elsif ($buffer[$count-1] eq "\n") {
&ade_err_debug($errstack_ref, 10, "[1NL]");
#print "
";
&safeprint($errstack_ref, "$buffer[--$count]");
} elsif ($buffer[$count-1] eq "") {
&ade_err_error($errstack_ref, "control sequence starts with ^H");
} else {
# else must wait for more
&ade_err_debug($errstack_ref, 10, "[1WAIT]");
}
} elsif ($count == 2) {
if ($buffer[$count-1] eq " ") {
&ade_err_debug($errstack_ref, 10, "[2SPNL]");
&switchto($errstack_ref, "normal");
&safeprint($errstack_ref, "$buffer[0]");
&safeprint($errstack_ref, "$buffer[1]");
$count = 0;
} elsif ($buffer[$count-1] eq "\n") {
&ade_err_debug($errstack_ref, 10, "[2SPNL]");
&switchto($errstack_ref, "normal");
&safeprint($errstack_ref, "$buffer[0]");
#print "
";
&safeprint($errstack_ref, "$buffer[1]");
$count = 0;
} elsif ($buffer[$count-1] eq "") {
; # must wait for end of X^H? sequence
&ade_err_debug($errstack_ref, 10, "[2WAIT]");
} else {
&ade_err_debug($errstack_ref, 10, "[2NORMSHUF]");
&switchto($errstack_ref, "normal");
# print oldest char and shuffle
&safeprint($errstack_ref, "$buffer[0]");
$buffer[0] = $buffer[1];
$count--;
}
} elsif ($count == 3) {
if ($buffer[$count-1] eq " " or $buffer[$count-1] eq "\n") {
&ade_err_error($errstack_ref, "^H{|: invalid control sequence");
} elsif ($buffer[0] eq "_") {
&ade_err_debug($errstack_ref, 10, "[3ITALIC]");
&switchto($errstack_ref, "italic");
&safeprint($errstack_ref, "$buffer[2]");
$count = 0;
} elsif ($buffer[$count-1] eq $buffer[0]) {
&ade_err_debug($errstack_ref, 10, "[3BOLD]");
&switchto($errstack_ref, "bold");
&safeprint($errstack_ref, "$buffer[0]");
$count = 0;
} elsif ($buffer[$count-1] eq "o" && $buffer[0] eq "+") {
&ade_err_debug($errstack_ref, 10, "[BULLET]");
&switchto($errstack_ref, "normal");
&safeprint($errstack_ref, "o");
$count = 0;
} else {
&ade_err_error($errstack_ref, "$buffer[0]^H$buffer[2]: invalid control sequence");
}
} else {
&ade_err_error($errstack_ref, sprintf("%s: invalid control sequence", join("", @buffer)));
}
}
if ($count == 0) {
; # nothing to do
} elsif ($count == 1) {
&switchto($errstack_ref, "normal");
&safeprint($errstack_ref, "$buffer[--$count]");
} elsif ($count == 2) {
&ade_err_error($errstack_ref, "$buffer[0]^H: control sequence incomplete");
}
print "\n";
if (!$opt_fragment) {
print "\n";
print "\n";
}
close(PIPE);
return $ade_err_ok;
}
sub ademan2html_version
{
my($errstack_ref, $version_ref) = @_;
return(&ade_smf_extractversionfromsvnstring($errstack_ref, $app_svnid, $version_ref));
}
sub ademan2html_listpaths
{
my($errstack_ref, $pathlist_ref) = @_;
my($rc);
%{$pathlist_ref} = ();
return($ade_err_ok);
}
sub ademan2html_usage
{
my($errstack_ref, $passno) = @_;
if ($passno == 1) {
print "\n";
} elsif ($passno == 2) {
print " --fragment omit and enclosure\n";
} else {
&ade_err_error($errstack_ref, ademan2html_err_internal, "ademan2html_usage: $passno: bad pass number");
return($ade_err_fail);
}
return($ade_err_ok);
}
sub safeprint
{
my($errstack_ref, $c) = @_;
if ($c eq ">") {
print ">";
} elsif ($c eq "<") {
print "<";
} else {
print $c;
}
return($ade_err_ok);
}
BEGIN {
# Function-static variables
my($current_mode) = "normal";
sub switchto
{
my($errstack_ref, $mode) = @_;
if ($mode eq $current_mode) {
return($ade_err_ok);
}
if ($current_mode eq "bold") {
print "";
$current_mode = "normal";
} elsif ($current_mode eq "italic") {
print "";
$current_mode = "normal";
}
if ($mode eq "bold") {
print "";
$current_mode = "bold";
} elsif ($mode eq "italic") {
print "";
$current_mode = "italic";
}
return($ade_err_ok);
}
}
&ade_gep_main(\&ademan2html);