help.pl

   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/\&/&amp;/g;
  41         s/\</&lt;/g;
  42         s/\>/&gt;/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) {
  96         $o .= "See <A href=\"$sf\">top level</A>.\n";
  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 }