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