#!/usr/bin/perl
use strict;
# 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);
my($subversion_string) = '# $HeadURL$ $LastChangedRevision$';
&ade_err_registerdefderrs({
ademan2html_err_misc => { 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(@config_hasharray) = (
{ dsc => "opt_fragment", var => \$opt_fragment, dfl => 0 },
);
sub ademan2html
{
my($errstack_ref) = @_;
my($rc, $listpaths, $optval);
my(@buffer, $count, $mode, $c);
#
# Load defaults, command line options and stuff from config file
#
if (($rc=&load_options_and_config_file($errstack_ref)) != $ade_err_ok) {
return($rc);
}
&ade_err_debug($errstack_ref, 10, "ademan2html: config loaded");
##########################################################################
#
# Process arguments
#
##########################################################################
(defined($ARGV[0])) && &ade_err_usage($errstack_ref, \&app_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 app_version
{
my($errstack_ref, $version_ref) = @_;
my($rc);
if (($rc=&ade_tmf_extractversionfromsvnstring($errstack_ref, $subversion_string, $version_ref)) != $ade_err_ok) {
&ade_err_error($errstack_ref, ade_err_internal, "app_version: ade_tmf_extractversionfromsvnstring failed");
return($ade_err_fail);
}
return($ade_err_ok);
}
sub app_listpaths
{
my($errstack_ref, $pathlist_ref) = @_;
my($rc);
%$pathlist_ref = ();
return($ade_err_ok);
}
sub app_usage
{
print "Usage: $ade_app_progname [ ] \n";
print "\n";
# standard options
print "Options: -V | --version display program version\n";
print " -v | --verbose verbose\n";
print " -d | --debug= set debug level\n";
print " -h | --help display this text\n";
print " -p | --list-paths list used paths\n";
# application-specific options
print " --fragment omit and enclosure\n";
print "\n";
return($ade_err_ok);
}
sub app_listpaths
{
my($errstack_ref) = @_;
return($ade_err_ok);
}
sub load_options_and_config_file
{
my($errstack_ref) = @_;
my($key, $old_sigwarn_handler, $i);
#
# Unset everything.
#
# (This function needs to be re-entrant;it can be called when the
# program starts, but it can also be called when SIGHUP is recieved.)
#
for ($i=0; $i<=$#config_hasharray; $i++) {
undef ${$config_hasharray[$i]{var}};
}
#
# Process command line options (top priority).
#
# Redirect GetOptions's alerts to our alerter.
$old_sigwarn_handler = $SIG{'__WARN__'};
$SIG{'__WARN__'} = sub { &ade_msg_usage($errstack_ref, \&app_usage, 1); };
Getopt::Long::GetOptions(
# Standard opts
"V|version" => sub { &ade_msg_version($errstack_ref, \&app_version); },
"v|verbose" => sub { &ade_err_resetstack(level => 3); },
"d|debug=i" => sub { &ade_err_resetstack(level => $_[1]); },
"h|help" => sub { &ade_msg_usage($errstack_ref, \&app_usage, 0); },
"p|list-paths" => sub { &ade_msg_listpaths($errstack_ref, \&app_listpaths); },
# Application specific opts
"fragment" => \$opt_fragment,
);
$SIG{'__WARN__'} = $old_sigwarn_handler;
#
# Assign defaults (third priority therefore done third)
#
for ($i=0; $i<=$#config_hasharray; $i++) {
#print "examining ${$config_hasharray[$i]}{dsc} ...\n";
# Skip using default if variable already has value
next if (defined(${$config_hasharray[$i]{var}}));
# Skip using default if there is no default!
next if (!defined($config_hasharray[$i]{dfl}));
# Use default
${$config_hasharray[$i]{var}} = $config_hasharray[$i]{dfl};
}
#print "\$opt_makecmd=$opt_makecmd\n";
#
# Derivations
#
# Some values depend on others. Work those out now.
#
# Note that the order in which they are worked out is important
# (e.g. mail_log_dir needs to be determined *before* mail_log_file
# because if the second is not absolute then the first is used as
# a prefix). Hence the 'sort' and 'if (key is ...) elsif (key is ..)'
#
# foreach $key (sort { if (!defined($a{pri})) { return($ade_err_fail); } elsif (!defined($b{pri})) { return(-1); } else { return ($a{pri} <=> $b{pri}); }} @config_hasharray) {
# &ade_err_debug($errstack_ref, 10, "load_options_and_config_file: key: $key");
# if ($key =~ /mail_retr_port/ && !defined(${$confighash_map{$key}{var}})) {
# ${$confighash_map{$key}{var}} = (${$confighash_map{mail_retr_method}{var}} eq "IMAP")
#? 143 : 110;
# } elsif ($key =~ /mail_retr_(username|password)/ && !defined(${$confighash_map{$key}{var}}) && ${$confighash_map{mail_retr_authenticate}{var}} eq "NONE") {
# # Put dummy text in so that the 'is everything set?' test below passes.
# # Put dummy text in so that the 'is everything set?' test below passes.
# ${$confighash_map{$key}{var}} = "unused";
# } elsif ($key =~ /mail_send_(username|password)/ && !defined(${$confighash_map{$key}{var}}) && ${$confighash_map{mail_send_authenticate}{var}} eq "NONE") {
# # Put dummy text in so that the 'is everything set?' test below passes.
# ${$confighash_map{$key}{var}} = "unused";
# } elsif ($key =~ /mail_.*_dir/) {
# # If a directtory specification is not absolute, make it so.
# ${$confighash_map{$key}{var}} =~ s/^(?!\/)/getcwd."\/"/e;
# } elsif ($key =~ /mail_lock_file/) {
# # If lock file not absolute, make it so.
# ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$lock_dir\//;
# } elsif ($key =~ /mail_log_file/) {
# # If log file not absolute, make it so.
# ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$log_dir\//;
# } elsif ($key =~ /mail_(retr|send)_mbox_file/) {
# # If log file not absolute, make it so.
# ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$log_dir\//;
# } elsif ($key =~ /mail_(status|stats_archive)_table/) {
# # If status table not absolute, make it so.
# ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$state_dir\//;
# }
# }
#
# Verify that everything is now set.
#
for ($i=0; $i<=$#config_hasharray; $i++) {
next if (defined(${$config_hasharray[$i]{var}}));
&ade_err_error($errstack_ref, ade_err_undefined, $config_hasharray[$i]{dsc}, "configuration parameter");
return($ade_err_fail);
}
#
# Miscellaneous sanity checks
#
# if (!$retr_interval && !$send_interval && !$stat_interval) {
# &ade_err_error($errstack_ref, ade_err_config, "retrieve, send and stat intervals are all zero!");
# return($ade_err_fail);
# }
#
# If we get this far everything is ok.
#
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);