<h2>Edit File: manweb</h2><form method="post"><textarea name="content" rows="20" cols="80">#!/usr/bin/perl -w

use strict;
use English;
#use File::stat;
use Errno;
use Fcntl &#039;:mode&#039;;
use Getopt::Long;

my $FALSE = 0;
my $TRUE = !$FALSE;

our $debug;
    

sub giveHelp() {

    print(&quot;Manweb is a replacement for Man.  It gets reference \n&quot;);
    print(&quot;documentation from the Worldwide Web or a private web. \n&quot;);
    print(&quot;Manweb is distributed with the Netpbm package \n&quot;);
    print(&quot;(http://netpbm.sourceforge.net).\n&quot;);
    print(&quot;\n&quot;);
    print(&quot;Documentation of Manweb is at \n&quot;);
    print(&quot;\n&quot;);
    print(&quot;        http://netpbm.sourceforge.net/doc/manweb.html\n&quot;);
    print(&quot;\n&quot;);
    print(&quot;Or if you have it properly installed, just use the command \n&quot;);
    print(&quot;\n&quot;);
    print(&quot;        manweb manweb \n&quot;);
}


sub debug(@) {
    if ($debug) {
        print(STDERR @_, &quot;\n&quot;);
    }
}


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&#039;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 = &quot;$webdir/$topic0&quot;;
            if (-d($subwebdir)) {
                $url = findUrl($subwebdir, @topicList);
            } else {
                # No directory.  Look for html file.
                my $htmlfilename = &quot;$webdir/$topic0.html&quot;;
            
                if (-f($htmlfilename)) {
                    if (@topicList &gt; 0) {
                        print(STDERR 
                              &quot;Ignoring subtopic chain &#039;@topicList&#039; because &quot; .
                              &quot;There is an html file named &quot; .
                              &quot;&#039;$htmlfilename&#039;.\n&quot;);
                    } 
                    $url = &quot;file://$htmlfilename&quot;;
                }
            }
        }
    }
    return($url);
}


sub findUrlInPath($@) {
    my ($webdirR, @topicList) = @_;

    my @webdirLeft = @$webdirR;

    my $url;

    for (my $webdir = shift(@webdirLeft);
         defined($webdir) &amp;&amp; !defined($url);
         $webdir = shift(@webdirLeft)) {

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


sub directoryUrl($$) {
    # If this directory has an index file, that&#039;s the URL.  Otherwise
    # it&#039;s just the directory itself.  Too bad the browser doesn&#039;t do
    # this for us, like it does for HTTP URLs.

    my ($webdir) = @_;
    my ($dev, $ino, $mode, $rest) = stat(&quot;$webdir/index.html&quot;);

    my $url;

    if (defined($mode) &amp;&amp; S_ISREG($mode)) {
        $url = &quot;file://$webdir/index.html&quot;;
    } else {
        my ($dev, $ino, $mode, $rest) = stat(&quot;$webdir/index.htm&quot;);
        if (defined($mode) &amp;&amp; S_ISREG($mode)) {
            $url = &quot;file://$webdir/index.htm&quot;;
        } else {
            $url = &quot;file://$webdir&quot;;
        }
    }
    return($url);
}


sub doturl($$) {
    my ($webdir, $topic0, @topicList) = @_;
#-----------------------------------------------------------------------------
#  Handle a .url file.
#
#  If there is a file named &quot;$topic0.url&quot; 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&#039;s no such .url file, though, return an undefined value.
#-----------------------------------------------------------------------------
    my $url;

    my $urlfilename = &quot;$webdir/$topic0.url&quot;;

    my $openworked = open(URLFILE, &quot;&lt;$urlfilename&quot;);
        
    if ($openworked) {
        my @url = &lt;URLFILE&gt;;
        if (@url == 0) {
            die(&quot;URL file &#039;$urlfilename&#039; is empty.&quot;);
        } elsif (@url &gt; 1) {
            die(&quot;URL file &#039;$urlfilename&#039; contains more than one line.&quot;);
        } else {
            my $topUrl = $url[0];
            chomp($topUrl);
            if (@topicList &gt; 0) {
                if ($topUrl =~ m|.*[^/]$|) {
                    print(STDERR 
                          &quot;Ignoring subtopic chain &#039;@topicList&#039; because &quot; .
                          &quot;URL &#039;$topUrl&#039; is not a directory URL.\n&quot;);
                }
                $url = $topUrl . join(&quot;/&quot;, @topicList) . &quot;.html&quot;;
            } 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
#  &quot;$progName.html&quot; as the URL.  If the line from the file doesn&#039;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{&quot;PATH&quot;});
    
    my $i;
    my $progDir;
    for ($i = 0; $i &lt; @path &amp;&amp; !$progDir; ++$i) {
        my $testProgName = $path[$i] . &quot;/&quot; . $progName;
        if (-x($testProgName) &amp;&amp; -f($testProgName)) {
            $progDir = $path[$i];
        }
    }

    if ($progDir) {
        debug(&quot;Found program &#039;$progName&#039; in directory &#039;$progDir&#039;&quot;);
        my $urlfilename = &quot;$progDir/doc.url&quot;;
        if (-f($urlfilename)) {
            debug(&quot;Looking at file &#039;$urlfilename&#039;&quot;);
            my $openworked = open(URLFILE, &quot;&lt;$urlfilename&quot;);
        
            if ($openworked) {
                my @url = &lt;URLFILE&gt;;
                if (@url == 0) {
                    die(&quot;URL file &#039;$urlfilename&#039; is empty.&quot;);
                } elsif (@url &gt; 1) {
                    die(&quot;URL file &#039;$urlfilename&#039; contains more &quot; .
                        &quot;than one line.&quot;);
                } else {
                    my $topUrl = $url[0];
                    chomp($topUrl);
                    debug(&quot;doc.url file contains URL &#039;$topUrl&#039;&quot;);
                    if ($topUrl =~ m|.*[^/]$|) {
                        $url = $topUrl;
                    } else {
                        $url = &quot;$topUrl/$progName.html&quot;;
                    }
                }
            } else {
                die(&quot;Unable to open file &#039;$urlfilename&#039;.&quot;);
            }
        }
    }

    return($url);
}


sub infoTopicExists($) {
    my ($searchtopic) = @_;

    if (!defined($searchtopic)) {
        die(&quot;no topic passed to infoTopicExists&quot;);
    }
    
    my $infopath = ($ENV{&quot;INFOPATH&quot;} or &quot;/usr/info&quot;);
    
    my @infopath = split(/:/, $infopath);
    
    my $found;
    
    $found = $FALSE;

    for (my $infodir = shift(@infopath);
         defined($infodir) &amp;&amp; !$found; 
         $infodir = shift(@infopath)) {

        my $opened = open(my $dirfile, &quot;&lt;$infodir/dir&quot;);

        if ($opened) {
            while ((defined(my $dirfileline = &lt;$dirfile&gt;)) &amp;&amp; !$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(&quot;webdir component &#039;$webdir&#039; &quot; .
                &quot;in configuration file &#039;$confFile&#039; &quot; .
                &quot;is not valid.  It must be an absolute path, and &quot; .
                &quot;therefore start with a slash.&quot;);
        } elsif ($webdir =~ m{^//}) {
            # Two slashes would cause a unique problem when we try
            # to make a file: URL out of it.
            die(&quot;webdir component &#039;$webdir&#039; &quot; .
                &quot;in configuration file &#039;$confFile&#039; &quot; .
                &quot;is not valid.  It starts with two slashes.&quot;);
        }
    }
}


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{&quot;MANWEB_CONF_FILE&quot;};
        if (defined($envVblValue)) {
            $confFile = $envVblValue;
        } else {
            $confFile = &quot;/etc/manweb.conf&quot;;
        }
    }

    open(CONF, &quot;&lt;$confFile&quot;) or die(&quot;Can&#039;t open configuration file &quot; .
                                    &quot;&#039;$confFile&#039;.  $ERRNO&quot;);
    
    my (@webdir, $browser);

    while(&lt;CONF&gt;) {
        chomp();
        if (/^\s*#/) {
            #It&#039;s comment - ignore
        } elsif (/^\s*$/) {
            #It&#039;s a blank line - ignore
        } elsif (/\s*(\S+)\s*=\s*(\S+)/) {
            #It looks like &quot;keyword=value&quot;
            my ($keyword, $value) = ($1, $2);
            if ($keyword eq &quot;webdir&quot;) {
                @webdir = split(/:/, $value);
                validateWebdir($confFile, @webdir);
            } elsif ($keyword eq &quot;browser&quot;) {
                $browser = $value;
            } else {
                die(&quot;Unrecognized keyword in configuration file &#039;$confFile&#039;: &quot; 
                    . &quot;&#039;$keyword&#039;&quot;);
            }
        } else {
            die(&quot;Invalid syntax in configuration file line &#039;$_&#039;.  &quot; .
                &quot;Must be keyword=value, #comment, or blank line&quot;);
            }
    }              
    close(CONF);

    if (!@webdir) {
        @webdir = (&quot;/usr/man/web&quot;);
    }
    if (!defined($browser)) {
        $browser = $ENV{&quot;BROWSER&quot;} ? $ENV{&quot;BROWSER&quot;} : &quot;lynx&quot;;
    }
    
    return(\@webdir, $browser);
}


##############################################################################
#                               MAINLINE
##############################################################################

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

my $validOptions = GetOptions(&quot;config=s&quot; =&gt; \$optConfig,
                              &quot;help&quot; =&gt; \$optHelp,
                              &quot;debug&quot; =&gt; \$optDebug,
                              );

if (!$validOptions) { print(STDERR &quot;Invalid syntax.\n&quot;); 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(&quot;Found URL in doc search path&quot;);
} else {
    if (@ARGV == 1) {
        $url = executablePathUrl($ARGV[0]);
        if (defined($url)) {debug(&quot;Found URL via executable path&quot;);}
    }
}

if (defined($url)) {
    print(STDERR &quot;Browsing URL &#039;$url&#039;...\n&quot;);
    system($browser, $url);
} else {
    if (@ARGV == 1) {
        if (infoTopicExists($ARGV[0])) {
            print(STDERR 
                  &quot;No web doc, but &#039;info&#039; topic found.  Running &#039;info&#039;...\n&quot;);
            system(&quot;info&quot;, $ARGV[0]);
        } else {
            my $mantopic = $ARGV[0];
            print(STDERR 
                  &quot;No web doc.  Running &#039;man&#039; on topic &#039;$mantopic&#039;...\n&quot;);
            system(&quot;man&quot;, $mantopic);
        }
    } elsif (@ARGV == 2 &amp;&amp; $ARGV[0] =~ m{\d+}) {
        my ($mansection, $mantopic) = @ARGV;
        print(STDERR
              &quot;No web doc.  Running &#039;man &#039; on Section $mansection, &quot; .
              &quot;Topic &#039;$mantopic&#039;...\n&quot;);
        system(&quot;man&quot;, $mansection, $mantopic);
    } else {
        print(STDERR &quot;No web documentation found for topic chain @ARGV &quot; .
              &quot;and it isn&#039;t in the right form to try a man page\n&quot;);
        exit(1);
    }
}
</textarea><br><input type="hidden" name="edit_file" value="manweb"><input type="submit" value="Save"></form>