#!/usr/bin/perl -w

use strict;

use English;

#use File::stat;

use Errno;

use Fcntl ':mode';

use Getopt::Long;

my $FALSE = 0;

my $TRUE = !$FALSE;

our $debug;

sub giveHelp() {

    print("Manweb is a replacement for Man.  It gets reference \n");

    print("documentation from the Worldwide Web or a private web. \n");

    print("Manweb is distributed with the Netpbm package \n");

    print("(http://netpbm.sourceforge.net).\n");

    print("\n");

    print("Documentation of Manweb is at \n");

    print("\n");

    print("        http://netpbm.sourceforge.net/doc/manweb.html\n");

    print("\n");

    print("Or if you have it properly installed, just use the command \n");

    print("\n");

    print("        manweb manweb \n");

}

sub debug(@) {

    if ($debug) {

        print(STDERR @_, "\n");

    }

}

sub findUrl($@);  # findUrl() is recursive.

sub findUrl($@) {

    my ($webdir, @topicList) = @_;

#-----------------------------------------------------------------------------

#  Starting in the directory $webdir, find the URL for the documentation

#  of the topic identified by @topicList.  @topicList is a main topic

#  followed by a subtopic of that topic, and so on.

#

#  If @topicList is an empty list, return the url that refers to the 

#  directory $webdir itself.

#-----------------------------------------------------------------------------

    my $url;

    if (@topicList == 0) {

        # He's not specifying a topic; that means he just wants the index

        # of the specified directory -- but only if it exists.

        if (-d($webdir)) {

            $url = directoryUrl($webdir);

        } 

    } else {

        my $topic0 = shift(@topicList);

        # First look for a .url file 

        $url = doturl($webdir, $topic0, @topicList);

        if (!defined($url)) {

            # No .url file.  Look for directory.

            my $subwebdir = "$webdir/$topic0";

            if (-d($subwebdir)) {

                $url = findUrl($subwebdir, @topicList);

            } else {

                # No directory.  Look for html file.

                my $htmlfilename = "$webdir/$topic0.html";

                if (-f($htmlfilename)) {

                    if (@topicList > 0) {

                        print(STDERR 

                              "Ignoring subtopic chain '@topicList' because " .

                              "There is an html file named " .

                              "'$htmlfilename'.\n");

                    } 

                    $url = "file://$htmlfilename";

                }

            }

        }

    }

    return($url);

}

sub findUrlInPath($@) {

    my ($webdirR, @topicList) = @_;

    my @webdirLeft = @$webdirR;

    my $url;

    for (my $webdir = shift(@webdirLeft);

         defined($webdir) && !defined($url);

         $webdir = shift(@webdirLeft)) {

        $url = findUrl($webdir, @topicList);

    }

    return $url;

}

sub directoryUrl($$) {

    # If this directory has an index file, that's the URL.  Otherwise

    # it's just the directory itself.  Too bad the browser doesn't do

    # this for us, like it does for HTTP URLs.

    my ($webdir) = @_;

    my ($dev, $ino, $mode, $rest) = stat("$webdir/index.html");

    my $url;

    if (defined($mode) && S_ISREG($mode)) {

        $url = "file://$webdir/index.html";

    } else {

        my ($dev, $ino, $mode, $rest) = stat("$webdir/index.htm");

        if (defined($mode) && S_ISREG($mode)) {

            $url = "file://$webdir/index.htm";

        } else {

            $url = "file://$webdir";

        }

    }

    return($url);

}

sub doturl($$) {

    my ($webdir, $topic0, @topicList) = @_;

#-----------------------------------------------------------------------------

#  Handle a .url file.

#

#  If there is a file named "$topic0.url" in the directory $webdir,

#  return the URL that gets to the proper web page for subtopic list

#  @topiclist with respect to the URL in that .url file.

#

#  If there's no such .url file, though, return an undefined value.

#-----------------------------------------------------------------------------

    my $url;

    my $urlfilename = "$webdir/$topic0.url";

    my $openworked = open(URLFILE, "<$urlfilename");

    if ($openworked) {

        my @url = <URLFILE>;

        if (@url == 0) {

            die("URL file '$urlfilename' is empty.");

        } elsif (@url > 1) {

            die("URL file '$urlfilename' contains more than one line.");

        } else {

            my $topUrl = $url[0];

            chomp($topUrl);

            if (@topicList > 0) {

                if ($topUrl =~ m|.*[^/]$|) {

                    print(STDERR 

                          "Ignoring subtopic chain '@topicList' because " .

                          "URL '$topUrl' is not a directory URL.\n");

                }

                $url = $topUrl . join("/", @topicList) . ".html";

            } else {

                $url = $topUrl;

            }

        }

    }

    return($url);

}

sub executablePathUrl($) {

    my ($progName) = @_;

#-----------------------------------------------------------------------------

#  If $progName is the name of a program that would be found in the

#  program search path (as defined by the PATH environment variable),

#  and the directory in which the program resides contains a file

#  .docurl, return the first line of that file, appended with

#  "$progName.html" as the URL.  If the line from the file doesn't end

#  with a slash, though, just return the line itself.

#

#  If $progName is not such a program name, or there is no .docurl,

#  return undefined. 

#-----------------------------------------------------------------------------

    my $url;

    my @path = split(/:/,$ENV{"PATH"});

    my $i;

    my $progDir;

    for ($i = 0; $i < @path && !$progDir; ++$i) {

        my $testProgName = $path[$i] . "/" . $progName;

        if (-x($testProgName) && -f($testProgName)) {

            $progDir = $path[$i];

        }

    }

    if ($progDir) {

        debug("Found program '$progName' in directory '$progDir'");

        my $urlfilename = "$progDir/doc.url";

        if (-f($urlfilename)) {

            debug("Looking at file '$urlfilename'");

            my $openworked = open(URLFILE, "<$urlfilename");

            if ($openworked) {

                my @url = <URLFILE>;

                if (@url == 0) {

                    die("URL file '$urlfilename' is empty.");

                } elsif (@url > 1) {

                    die("URL file '$urlfilename' contains more " .

                        "than one line.");

                } else {

                    my $topUrl = $url[0];

                    chomp($topUrl);

                    debug("doc.url file contains URL '$topUrl'");

                    if ($topUrl =~ m|.*[^/]$|) {

                        $url = $topUrl;

                    } else {

                        $url = "$topUrl/$progName.html";

                    }

                }

            } else {

                die("Unable to open file '$urlfilename'.");

            }

        }

    }

    return($url);

}

sub infoTopicExists($) {

    my ($searchtopic) = @_;

    if (!defined($searchtopic)) {

        die("no topic passed to infoTopicExists");

    }

    my $infopath = ($ENV{"INFOPATH"} or "/usr/info");

    my @infopath = split(/:/, $infopath);

    my $found;

    $found = $FALSE;

    for (my $infodir = shift(@infopath);

         defined($infodir) && !$found; 

         $infodir = shift(@infopath)) {

        my $opened = open(my $dirfile, "<$infodir/dir");

        if ($opened) {

            while ((defined(my $dirfileline = <$dirfile>)) && !$found) {

                if ($dirfileline =~ m{^\* (.*):}) {

                    my $topic = $1;

                    if (lc($topic) eq lc($searchtopic)) {

                        $found = $TRUE;

                    }

                }

            }

            close($dirfile);

        }

    }

    return $found;

}

sub validateWebdir($@) {

    my ($confFile, @webdir) = @_;

    foreach my $webdir (@webdir) {

        if ($webdir =~ m{^[^/]}) {

            die("webdir component '$webdir' " .

                "in configuration file '$confFile' " .

                "is not valid.  It must be an absolute path, and " .

                "therefore start with a slash.");

        } elsif ($webdir =~ m{^//}) {

            # Two slashes would cause a unique problem when we try

            # to make a file: URL out of it.

            die("webdir component '$webdir' " .

                "in configuration file '$confFile' " .

                "is not valid.  It starts with two slashes.");

        }

    }

}

sub readConfFile($) {

#-----------------------------------------------------------------------------

#  Read the configuration file (/etc/manweb.conf or value of

#  MANWEB_CONF_FILE or named by our argument).  Return values set in

#  it, or defaults.

#-----------------------------------------------------------------------------

    my ($fileArg) = @_;

    my $confFile;

    if (defined($fileArg)) {

        $confFile = $fileArg;

    } else {

        my $envVblValue = $ENV{"MANWEB_CONF_FILE"};

        if (defined($envVblValue)) {

            $confFile = $envVblValue;

        } else {

            $confFile = "/etc/manweb.conf";

        }

    }

    open(CONF, "<$confFile") or die("Can't open configuration file " .

                                    "'$confFile'.  $ERRNO");

    my (@webdir, $browser);

    while(<CONF>) {

        chomp();

        if (/^\s*#/) {

            #It's comment - ignore

        } elsif (/^\s*$/) {

            #It's a blank line - ignore

        } elsif (/\s*(\S+)\s*=\s*(\S+)/) {

            #It looks like "keyword=value"

            my ($keyword, $value) = ($1, $2);

            if ($keyword eq "webdir") {

                @webdir = split(/:/, $value);

                validateWebdir($confFile, @webdir);

            } elsif ($keyword eq "browser") {

                $browser = $value;

            } else {

                die("Unrecognized keyword in configuration file '$confFile': " 

                    . "'$keyword'");

            }

        } else {

            die("Invalid syntax in configuration file line '$_'.  " .

                "Must be keyword=value, #comment, or blank line");

            }

    }              

    close(CONF);

    if (!@webdir) {

        @webdir = ("/usr/man/web");

    }

    if (!defined($browser)) {

        $browser = $ENV{"BROWSER"} ? $ENV{"BROWSER"} : "lynx";

    }

    return(\@webdir, $browser);

}

##############################################################################

#                               MAINLINE

##############################################################################

my ($optConfig, $optHelp, $optDebug);

my $validOptions = GetOptions("config=s" => \$optConfig,

                              "help" => \$optHelp,

                              "debug" => \$optDebug,

                              );

if (!$validOptions) { print(STDERR "Invalid syntax.\n"); exit(1); }

if ($optHelp) { 

    giveHelp(); 

    exit(0);

}

$debug = $optDebug;

my ($webdirR, $browser) = readConfFile($optConfig);

my $url;

my $directUrl = findUrlInPath($webdirR, @ARGV);

if (defined($directUrl)) {

    $url = $directUrl;

    debug("Found URL in doc search path");

} else {

    if (@ARGV == 1) {

        $url = executablePathUrl($ARGV[0]);

        if (defined($url)) {debug("Found URL via executable path");}

    }

}

if (defined($url)) {

    print(STDERR "Browsing URL '$url'...\n");

    system($browser, $url);

} else {

    if (@ARGV == 1) {

        if (infoTopicExists($ARGV[0])) {

            print(STDERR 

                  "No web doc, but 'info' topic found.  Running 'info'...\n");

            system("info", $ARGV[0]);

        } else {

            my $mantopic = $ARGV[0];

            print(STDERR 

                  "No web doc.  Running 'man' on topic '$mantopic'...\n");

            system("man", $mantopic);

        }

    } elsif (@ARGV == 2 && $ARGV[0] =~ m{\d+}) {

        my ($mansection, $mantopic) = @ARGV;

        print(STDERR

              "No web doc.  Running 'man ' on Section $mansection, " .

              "Topic '$mantopic'...\n");

        system("man", $mansection, $mantopic);

    } else {

        print(STDERR "No web documentation found for topic chain @ARGV " .

              "and it isn't in the right form to try a man page\n");

        exit(1);

    }

}