From 1fd361a1ea06e44286c213ca1f814f49306fdc43 Mon Sep 17 00:00:00 2001 From: giraffedata Date: Sat, 19 Aug 2006 03:12:28 +0000 Subject: Create Subversion repository git-svn-id: http://svn.code.sf.net/p/netpbm/code/trunk@1 9d0c8265-081b-0410-96cb-a4ca84ce46f8 --- manweb | 427 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 427 insertions(+) create mode 100755 manweb (limited to 'manweb') diff --git a/manweb b/manweb new file mode 100755 index 00000000..988c8f68 --- /dev/null +++ b/manweb @@ -0,0 +1,427 @@ +#!/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 = ; + 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 = ; + 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() { + 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); + } +} -- cgit 1.4.1