| 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 | $sf = "/help"; |
| 28 | |
| 29 | while (<HI>) { |
| 30 | s/\s+$//; |
| 31 | if (m/^\:([$tc]*)$/) { |
| 32 | $topic= $1; |
| 33 | } elsif (m/^\#/) { |
| 34 | } elsif (m/^\:\:(\w+)\s*(.*)$/) { |
| 35 | $config{$1}= $2; |
| 36 | } elsif (m/^$/) { |
| 37 | undef $topic; |
| 38 | } else { |
| 39 | fail("notopic") unless defined $topic; |
| 40 | $_= "_$_"; |
| 41 | s/\&/&/g; |
| 42 | s/\</</g; |
| 43 | s/\>/>/g; |
| 44 | s#([^\\])\!\$([$tc]+)# |
| 45 | $1."<A href=\"$sf\">".$2."</A>"; |
| 46 | #ge; |
| 47 | s#([^\\])\!([$tc]+)# |
| 48 | $xrefs{$topic}{$2}++; |
| 49 | $1."<A href=\"$sf/$2\">".$2."</A>"; |
| 50 | #ge; |
| 51 | s/\\(.)/$1/g; |
| 52 | s/^_//; |
| 53 | $lines{$topic} .= "$_\n"; |
| 54 | } |
| 55 | } |
| 56 | |
| 57 | fail("intopic") if defined $topic; |
| 58 | |
| 59 | close HI or fail("close hi $!"); |
| 60 | |
| 61 | foreach $topic (keys %xrefs) { |
| 62 | foreach $xr (keys %{ $xrefs{$topic} }) { |
| 63 | defined $lines{$xr} or fail("$topic -> $xr"); |
| 64 | } |
| 65 | } |
| 66 | |
| 67 | $topic= $ENV{'PATH_INFO'}; |
| 68 | $topic =~ s,.*/,,; |
| 69 | |
| 70 | fail("unknown topic") unless $topic eq 'ALL' || defined $lines{$topic}; |
| 71 | |
| 72 | $o= <<END; |
| 73 | Content-Type: text/html |
| 74 | |
| 75 | <html><head> |
| 76 | <title>$config{'wwwtitle'} |
| 77 | END |
| 78 | |
| 79 | $o .= "- $topic" if length $topic; |
| 80 | $o .= <<END; |
| 81 | </title> |
| 82 | </head><body> |
| 83 | END |
| 84 | |
| 85 | if ($topic eq 'ALL') { |
| 86 | $o.= "<h1>All help topics in alphabetical order</h1>\n"; |
| 87 | foreach $pt (sort keys %lines) { |
| 88 | printout($pt); |
| 89 | } |
| 90 | } else { |
| 91 | $o.= "<h1>".ptitle($topic)." and its cross-references</h1>\n"; |
| 92 | printout($topic); |
| 93 | foreach $xr (sort keys %{ $xrefs{$topic} }) { |
| 94 | printout($xr) unless $xr eq $topic; |
| 95 | } |
| 96 | if (length $topic) { |
| 97 | $o .= "See <A href=\"$sf\">top level</A>.\n"; |
| 98 | } |
| 99 | $o .= "See <A href=\"$sf/ALL\">all topics</A>.\n<hr>\n" |
| 100 | } |
| 101 | |
| 102 | $o.= "<address>$config{'wwwaddress'}</address>\n"; |
| 103 | $o.= "</body></html>\n"; |
| 104 | |
| 105 | print $o or die $!; |
| 106 | |
| 107 | sub ptitle ($) { length $_[0] ? $_[0] : 'top level'; } |
| 108 | |
| 109 | sub printout ($) { |
| 110 | my ($pt) = @_; |
| 111 | my ($title,$rurl); |
| 112 | $title= ptitle($pt); |
| 113 | $rurl= length $pt ? "$sf/$pt" : $sf; |
| 114 | $o .= '<h2>'; |
| 115 | if ($pt eq $topic) { |
| 116 | $o .= $title; |
| 117 | } else { |
| 118 | $o .= "<A href=\"$rurl\">$title</A>"; |
| 119 | } |
| 120 | $o .= "</h2>\n<pre>\n"; |
| 121 | $o .= $lines{$pt}; |
| 122 | $o .= "</pre>\n<hr>\n"; |
| 123 | } |