Commit | Line | Data |
---|---|---|
5e5be903 IJ |
1 | #!/usr/bin/perl |
2 | ||
3 | $_= $ENV{'SCRIPT_FILENAME'}; | |
4 | defined $_ or $_= $0; | |
5 | ||
6 | sub fail ($) { | |
7 | print "Content-Type: text/plain\n\nERROR\n$_[0]\n" or die $!; | |
8 | exit 0; | |
9 | } | |
10 | ||
11 | for (;;) { | |
12 | lstat $_ or fail("lstat $_ $!"); | |
13 | last unless -l _; | |
14 | defined($rl= readlink) or fail("readlink $_ $!"); | |
15 | if ($rl =~ m,^/,) { | |
16 | $_= $rl; | |
17 | } else { | |
18 | s,/[^/]+$,/$rl, or fail("linksub $_ ?"); | |
19 | } | |
20 | } | |
21 | s,/[^/]+$,/helpinfos, or die "$_ ?"; | |
22 | ||
23 | open HI, "< $_" or die $?; | |
24 | ||
25 | $tc= '-+._0-9a-z'; | |
26 | $sf= $ENV{'SCRIPT_NAME'}; | |
27 | ||
28 | while (<HI>) { | |
29 | s/\s+$//; | |
30 | if (m/^\:([$tc]*)$/) { | |
31 | $topic= $1; | |
32 | } elsif (m/^\#/) { | |
33 | } elsif (m/^\:\:(\w+)\s*(.*)$/) { | |
34 | $config{$1}= $2; | |
35 | } elsif (m/^$/) { | |
36 | undef $topic; | |
37 | } else { | |
38 | fail("notopic") unless defined $topic; | |
39 | $_= "_$_"; | |
40 | s/\&/&/g; | |
41 | s/\</</g; | |
42 | s/\>/>/g; | |
43 | s#([^\\])\!\$([$tc]+)# | |
44 | $1."<A href=\"$sf\">".$2."</A>"; | |
45 | #ge; | |
46 | s#([^\\])\!([$tc]+)# | |
47 | $xrefs{$topic}{$2}++; | |
48 | $1."<A href=\"$sf/$2\">".$2."</A>"; | |
49 | #ge; | |
50 | s/\\(.)/$1/g; | |
51 | s/^_//; | |
52 | $lines{$topic} .= "$_\n"; | |
53 | } | |
54 | } | |
55 | ||
56 | fail("intopic") if defined $topic; | |
57 | ||
58 | close HI or fail("close hi $!"); | |
59 | ||
60 | foreach $topic (keys %xrefs) { | |
61 | foreach $xr (keys %{ $xrefs{$topic} }) { | |
62 | defined $lines{$xr} or fail("$topic -> $xr"); | |
63 | } | |
64 | } | |
65 | ||
66 | $topic= $ENV{'PATH_INFO'}; | |
67 | $topic =~ s,.*/,,; | |
68 | ||
69 | fail("unknown topic") unless $topic eq 'ALL' || defined $lines{$topic}; | |
70 | ||
71 | $o= <<END; | |
72 | Content-Type: text/html | |
73 | ||
74 | <html><head> | |
75 | <title>$config{'wwwtitle'} | |
76 | END | |
77 | ||
78 | $o .= "- $topic" if length $topic; | |
79 | $o .= <<END; | |
80 | </title> | |
81 | </head><body> | |
82 | END | |
83 | ||
84 | if ($topic eq 'ALL') { | |
85 | $o.= "<h1>All help topics in alphabetical order</h1>\n"; | |
86 | foreach $pt (sort keys %lines) { | |
87 | printout($pt); | |
88 | } | |
89 | } else { | |
90 | $o.= "<h1>".ptitle($topic)." and its cross-references</h1>\n"; | |
91 | printout($topic); | |
92 | foreach $xr (sort keys %{ $xrefs{$topic} }) { | |
93 | printout($xr) unless $xr eq $topic; | |
94 | } | |
95 | if (length $topic) { | |
bdf495dc | 96 | $o .= "See <A href=\"$sf\">top level</A>.\n"; |
5e5be903 IJ |
97 | } |
98 | $o .= "See <A href=\"$sf/ALL\">all topics</A>.\n<hr>\n" | |
99 | } | |
100 | ||
101 | $o.= "<address>$config{'wwwaddress'}</address>\n"; | |
102 | $o.= "</body></html>\n"; | |
103 | ||
104 | print $o or die $!; | |
105 | ||
106 | sub ptitle ($) { length $_[0] ? $_[0] : 'top level'; } | |
107 | ||
108 | sub printout ($) { | |
109 | my ($pt) = @_; | |
110 | my ($title,$rurl); | |
111 | $title= ptitle($pt); | |
112 | $rurl= length $pt ? "$sf/$pt" : $sf; | |
113 | $o .= '<h2>'; | |
114 | if ($pt eq $topic) { | |
115 | $o .= $title; | |
116 | } else { | |
117 | $o .= "<A href=\"$rurl\">$title</A>"; | |
118 | } | |
119 | $o .= "</h2>\n<pre>\n"; | |
120 | $o .= $lines{$pt}; | |
121 | $o .= "</pre>\n<hr>\n"; | |
122 | } |