| Current Path : /usr/bin/ |
Linux gator3171.hostgator.com 4.19.286-203.ELK.el7.x86_64 #1 SMP Wed Jun 14 04:33:55 CDT 2023 x86_64 |
| Current File : //usr/bin/manweb |
#!/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);
}
}