1#@!#!123s

: / bin /
Filename : manweb
back
#!/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);
    }
}