1#!/usr/bin/perl -w 2 3use strict; 4use English; 5#use File::stat; 6use Errno; 7use Fcntl ':mode'; 8use Getopt::Long; 9 10my $FALSE = 0; 11my $TRUE = !$FALSE; 12 13our $debug; 14 15 16sub giveHelp() { 17 18 print("Manweb is a replacement for Man. It gets reference \n"); 19 print("documentation from the Worldwide Web or a private web. \n"); 20 print("Manweb is distributed with the Netpbm package \n"); 21 print("(http://netpbm.sourceforge.net).\n"); 22 print("\n"); 23 print("Documentation of Manweb is at \n"); 24 print("\n"); 25 print(" http://netpbm.sourceforge.net/doc/manweb.html\n"); 26 print("\n"); 27 print("Or if you have it properly installed, just use the command \n"); 28 print("\n"); 29 print(" manweb manweb \n"); 30} 31 32 33sub debug(@) { 34 if ($debug) { 35 print(STDERR @_, "\n"); 36 } 37} 38 39 40sub findUrl($@); # findUrl() is recursive. 41 42sub findUrl($@) { 43 my ($webdir, @topicList) = @_; 44#----------------------------------------------------------------------------- 45# Starting in the directory $webdir, find the URL for the documentation 46# of the topic identified by @topicList. @topicList is a main topic 47# followed by a subtopic of that topic, and so on. 48# 49# If @topicList is an empty list, return the url that refers to the 50# directory $webdir itself. 51#----------------------------------------------------------------------------- 52 my $url; 53 54 if (@topicList == 0) { 55 # He's not specifying a topic; that means he just wants the index 56 # of the specified directory -- but only if it exists. 57 58 if (-d($webdir)) { 59 $url = directoryUrl($webdir); 60 } 61 } else { 62 my $topic0 = shift(@topicList); 63 64 # First look for a .url file 65 66 $url = doturl($webdir, $topic0, @topicList); 67 if (!defined($url)) { 68 # No .url file. Look for directory. 69 70 my $subwebdir = "$webdir/$topic0"; 71 if (-d($subwebdir)) { 72 $url = findUrl($subwebdir, @topicList); 73 } else { 74 # No directory. Look for html file. 75 my $htmlfilename = "$webdir/$topic0.html"; 76 77 if (-f($htmlfilename)) { 78 if (@topicList > 0) { 79 print(STDERR 80 "Ignoring subtopic chain '@topicList' because " . 81 "There is an html file named " . 82 "'$htmlfilename'.\n"); 83 } 84 $url = "file://$htmlfilename"; 85 } 86 } 87 } 88 } 89 return($url); 90} 91 92 93 94sub findUrlInPath($@) { 95 my ($webdirR, @topicList) = @_; 96 97 my @webdirLeft = @$webdirR; 98 99 my $url; 100 101 for (my $webdir = shift(@webdirLeft); 102 defined($webdir) && !defined($url); 103 $webdir = shift(@webdirLeft)) { 104 105 $url = findUrl($webdir, @topicList); 106 } 107 return $url; 108} 109 110 111 112sub directoryUrl($$) { 113 # If this directory has an index file, that's the URL. Otherwise 114 # it's just the directory itself. Too bad the browser doesn't do 115 # this for us, like it does for HTTP URLs. 116 117 my ($webdir) = @_; 118 my ($dev, $ino, $mode, $rest) = stat("$webdir/index.html"); 119 120 my $url; 121 122 if (defined($mode) && S_ISREG($mode)) { 123 $url = "file://$webdir/index.html"; 124 } else { 125 my ($dev, $ino, $mode, $rest) = stat("$webdir/index.htm"); 126 if (defined($mode) && S_ISREG($mode)) { 127 $url = "file://$webdir/index.htm"; 128 } else { 129 $url = "file://$webdir"; 130 } 131 } 132 return($url); 133} 134 135 136 137 138sub doturl($$) { 139 my ($webdir, $topic0, @topicList) = @_; 140#----------------------------------------------------------------------------- 141# Handle a .url file. 142# 143# If there is a file named "$topic0.url" in the directory $webdir, 144# return the URL that gets to the proper web page for subtopic list 145# @topiclist with respect to the URL in that .url file. 146# 147# If there's no such .url file, though, return an undefined value. 148#----------------------------------------------------------------------------- 149 my $url; 150 151 my $urlfilename = "$webdir/$topic0.url"; 152 153 my $openworked = open(URLFILE, "<$urlfilename"); 154 155 if ($openworked) { 156 my @url = <URLFILE>; 157 if (@url == 0) { 158 die("URL file '$urlfilename' is empty."); 159 } elsif (@url > 1) { 160 die("URL file '$urlfilename' contains more than one line."); 161 } else { 162 my $topUrl = $url[0]; 163 chomp($topUrl); 164 if (@topicList > 0) { 165 if ($topUrl =~ m|.*[^/]$|) { 166 print(STDERR 167 "Ignoring subtopic chain '@topicList' because " . 168 "URL '$topUrl' is not a directory URL.\n"); 169 } 170 $url = $topUrl . join("/", @topicList) . ".html"; 171 } else { 172 $url = $topUrl; 173 } 174 } 175 } 176 return($url); 177} 178 179 180 181sub executablePathUrl($) { 182 my ($progName) = @_; 183#----------------------------------------------------------------------------- 184# If $progName is the name of a program that would be found in the 185# program search path (as defined by the PATH environment variable), 186# and the directory in which the program resides contains a file 187# .docurl, return the first line of that file, appended with 188# "$progName.html" as the URL. If the line from the file doesn't end 189# with a slash, though, just return the line itself. 190# 191# If $progName is not such a program name, or there is no .docurl, 192# return undefined. 193#----------------------------------------------------------------------------- 194 my $url; 195 196 my @path = split(/:/,$ENV{"PATH"}); 197 198 my $i; 199 my $progDir; 200 for ($i = 0; $i < @path && !$progDir; ++$i) { 201 my $testProgName = $path[$i] . "/" . $progName; 202 if (-x($testProgName) && -f($testProgName)) { 203 $progDir = $path[$i]; 204 } 205 } 206 207 if ($progDir) { 208 debug("Found program '$progName' in directory '$progDir'"); 209 my $urlfilename = "$progDir/doc.url"; 210 if (-f($urlfilename)) { 211 debug("Looking at file '$urlfilename'"); 212 my $openworked = open(URLFILE, "<$urlfilename"); 213 214 if ($openworked) { 215 my @url = <URLFILE>; 216 if (@url == 0) { 217 die("URL file '$urlfilename' is empty."); 218 } elsif (@url > 1) { 219 die("URL file '$urlfilename' contains more " . 220 "than one line."); 221 } else { 222 my $topUrl = $url[0]; 223 chomp($topUrl); 224 debug("doc.url file contains URL '$topUrl'"); 225 if ($topUrl =~ m|.*[^/]$|) { 226 $url = $topUrl; 227 } else { 228 $url = "$topUrl/$progName.html"; 229 } 230 } 231 } else { 232 die("Unable to open file '$urlfilename'."); 233 } 234 } 235 } 236 237 return($url); 238} 239 240 241 242sub infoTopicExists($) { 243 my ($searchtopic) = @_; 244 245 if (!defined($searchtopic)) { 246 die("no topic passed to infoTopicExists"); 247 } 248 249 my $infopath = ($ENV{"INFOPATH"} or "/usr/info"); 250 251 my @infopath = split(/:/, $infopath); 252 253 my $found; 254 255 $found = $FALSE; 256 257 for (my $infodir = shift(@infopath); 258 defined($infodir) && !$found; 259 $infodir = shift(@infopath)) { 260 261 my $opened = open(my $dirfile, "<$infodir/dir"); 262 263 if ($opened) { 264 while ((defined(my $dirfileline = <$dirfile>)) && !$found) { 265 if ($dirfileline =~ m{^\* (.*):}) { 266 my $topic = $1; 267 268 if (lc($topic) eq lc($searchtopic)) { 269 $found = $TRUE; 270 } 271 } 272 } 273 close($dirfile); 274 } 275 } 276 return $found; 277} 278 279 280sub validateWebdir($@) { 281 my ($confFile, @webdir) = @_; 282 283 foreach my $webdir (@webdir) { 284 285 if ($webdir =~ m{^[^/]}) { 286 die("webdir component '$webdir' " . 287 "in configuration file '$confFile' " . 288 "is not valid. It must be an absolute path, and " . 289 "therefore start with a slash."); 290 } elsif ($webdir =~ m{^//}) { 291 # Two slashes would cause a unique problem when we try 292 # to make a file: URL out of it. 293 die("webdir component '$webdir' " . 294 "in configuration file '$confFile' " . 295 "is not valid. It starts with two slashes."); 296 } 297 } 298} 299 300 301 302sub readConfFile($) { 303#----------------------------------------------------------------------------- 304# Read the configuration file (/etc/manweb.conf or value of 305# MANWEB_CONF_FILE or named by our argument). Return values set in 306# it, or defaults. 307#----------------------------------------------------------------------------- 308 my ($fileArg) = @_; 309 310 my $confFile; 311 312 if (defined($fileArg)) { 313 $confFile = $fileArg; 314 } else { 315 my $envVblValue = $ENV{"MANWEB_CONF_FILE"}; 316 if (defined($envVblValue)) { 317 $confFile = $envVblValue; 318 } else { 319 $confFile = "/etc/manweb.conf"; 320 } 321 } 322 323 open(CONF, "<$confFile") or die("Can't open configuration file " . 324 "'$confFile'. $ERRNO"); 325 326 my (@webdir, $browser); 327 328 while(<CONF>) { 329 chomp(); 330 if (/^\s*#/) { 331 #It's comment - ignore 332 } elsif (/^\s*$/) { 333 #It's a blank line - ignore 334 } elsif (/\s*(\S+)\s*=\s*(\S+)/) { 335 #It looks like "keyword=value" 336 my ($keyword, $value) = ($1, $2); 337 if ($keyword eq "webdir") { 338 @webdir = split(/:/, $value); 339 validateWebdir($confFile, @webdir); 340 } elsif ($keyword eq "browser") { 341 $browser = $value; 342 } else { 343 die("Unrecognized keyword in configuration file '$confFile': " 344 . "'$keyword'"); 345 } 346 } else { 347 die("Invalid syntax in configuration file line '$_'. " . 348 "Must be keyword=value, #comment, or blank line"); 349 } 350 } 351 close(CONF); 352 353 if (!@webdir) { 354 @webdir = ("/usr/man/web"); 355 } 356 if (!defined($browser)) { 357 $browser = $ENV{"BROWSER"} ? $ENV{"BROWSER"} : "lynx"; 358 } 359 360 return(\@webdir, $browser); 361} 362 363 364 365############################################################################## 366# MAINLINE 367############################################################################## 368 369my ($optConfig, $optHelp, $optDebug); 370 371my $validOptions = GetOptions("config=s" => \$optConfig, 372 "help" => \$optHelp, 373 "debug" => \$optDebug, 374 ); 375 376if (!$validOptions) { print(STDERR "Invalid syntax.\n"); exit(1); } 377 378if ($optHelp) { 379 giveHelp(); 380 exit(0); 381} 382 383$debug = $optDebug; 384 385my ($webdirR, $browser) = readConfFile($optConfig); 386 387my $url; 388 389my $directUrl = findUrlInPath($webdirR, @ARGV); 390 391if (defined($directUrl)) { 392 $url = $directUrl; 393 debug("Found URL in doc search path"); 394} else { 395 if (@ARGV == 1) { 396 $url = executablePathUrl($ARGV[0]); 397 if (defined($url)) {debug("Found URL via executable path");} 398 } 399} 400 401if (defined($url)) { 402 print(STDERR "Browsing URL '$url'...\n"); 403 system($browser, $url); 404} else { 405 if (@ARGV == 1) { 406 if (infoTopicExists($ARGV[0])) { 407 print(STDERR 408 "No web doc, but 'info' topic found. Running 'info'...\n"); 409 system("info", $ARGV[0]); 410 } else { 411 my $mantopic = $ARGV[0]; 412 print(STDERR 413 "No web doc. Running 'man' on topic '$mantopic'...\n"); 414 system("man", $mantopic); 415 } 416 } elsif (@ARGV == 2 && $ARGV[0] =~ m{\d+}) { 417 my ($mansection, $mantopic) = @ARGV; 418 print(STDERR 419 "No web doc. Running 'man ' on Section $mansection, " . 420 "Topic '$mantopic'...\n"); 421 system("man", $mansection, $mantopic); 422 } else { 423 print(STDERR "No web documentation found for topic chain @ARGV " . 424 "and it isn't in the right form to try a man page\n"); 425 exit(1); 426 } 427} 428