#!/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 "<html>\n";
        print "<body>\n";
    }
    if (($rc=&ade_spc_autogendheader($errstack_ref, \*STDOUT, "<!--", "-->", undef)) != $ade_err_ok) {
        close(PIPE);
        return($rc);
    }

    print "<pre>\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 "<br>";
                &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 "<br>";
                &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, "<char>^H{<space>|<newline>: 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 "</pre>\n";
    if (!$opt_fragment) {
        print "</body>\n";
        print "</html>\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 [ <options> ] <srcdir>\n";
    print "\n";
    #  standard options
    print "Options: -V | --version              display program version\n";
    print "         -v | --verbose              verbose\n";
    print "         -d | --debug=<level>        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 <html> and <body> 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 "&gt;";

    } elsif ($c eq "<") {
        print "&lt;";

    } 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 "</b>";
            $current_mode = "normal";
        } elsif ($current_mode eq "italic") {
            print "</i>";
            $current_mode = "normal";
        }
    
        if ($mode eq "bold") {
            print "<b>";
            $current_mode = "bold";
        } elsif ($mode eq "italic") {
            print "<i>";
            $current_mode = "italic";
        }

        return($ade_err_ok);
    }
}

&ade_gep_main(\&ademan2html);
