chiark - git - mdw - ircbot/blob - 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 $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/\&/&amp;/g;
  42         s/\</&lt;/g;
  43         s/\>/&gt;/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 }