[ircbot] / help.pl

#!/usr/bin/perl

$_= $ENV{'SCRIPT_FILENAME'};
defined $_ or $_= $0;

sub fail ($) {
    print "Content-Type: text/plain\n\nERROR\n$_[0]\n" or die $!;
    exit 0;
}

for (;;) {
    lstat $_ or fail("lstat $_ $!");
    last unless -l _;
    defined($rl= readlink) or fail("readlink $_ $!");
    if ($rl =~ m,^/,) {
	$_= $rl;
    } else {
	s,/[^/]+$,/$rl, or fail("linksub $_ ?");
    }
}
s,/[^/]+$,/helpinfos, or die "$_ ?";

open HI, "< $_" or die $?;

$tc= '-+._0-9a-z';
##$sf= $ENV{'SCRIPT_NAME'};
$sf = "/help";

while (<HI>) {
    s/\s+$//;
    if (m/^\:([$tc]*)$/) {
	$topic= $1;
    } elsif (m/^\#/) {
    } elsif (m/^\:\:(\w+)\s*(.*)$/) {
	$config{$1}= $2;
    } elsif (m/^$/) {
	undef $topic;
    } else {
	fail("notopic") unless defined $topic;
	$_= "_$_";
	s/\&/&amp;/g;
	s/\</&lt;/g;
	s/\>/&gt;/g;
	s#([^\\])\!\$([$tc]+)#
	   $1."<A href=\"$sf\">".$2."</A>";
	#ge;
	s#([^\\])\!([$tc]+)#
	   $xrefs{$topic}{$2}++;
	   $1."<A href=\"$sf/$2\">".$2."</A>";
	#ge;
	s/\\(.)/$1/g;
	s/^_//;
	$lines{$topic} .= "$_\n";
    }
}

fail("intopic") if defined $topic;

close HI or fail("close hi $!");

foreach $topic (keys %xrefs) {
    foreach $xr (keys %{ $xrefs{$topic} }) {
	defined $lines{$xr} or fail("$topic -> $xr");
    }
}

$topic= $ENV{'PATH_INFO'};
$topic =~ s,.*/,,;

fail("unknown topic") unless $topic eq 'ALL' || defined $lines{$topic};

$o= <<END;
Content-Type: text/html

<html><head>
<title>$config{'wwwtitle'}
END

$o .= "- $topic" if length $topic;
$o .= <<END;
</title>
</head><body>
END

if ($topic eq 'ALL') {
    $o.= "<h1>All help topics in alphabetical order</h1>\n";
    foreach $pt (sort keys %lines) {
	printout($pt);
    }
} else {
    $o.= "<h1>".ptitle($topic)." and its cross-references</h1>\n";
    printout($topic);
    foreach $xr (sort keys %{ $xrefs{$topic} }) {
	printout($xr) unless $xr eq $topic;
    }
    if (length $topic) {
	$o .= "See <A href=\"$sf\">top level</A>.\n";
    }
    $o .= "See <A href=\"$sf/ALL\">all topics</A>.\n<hr>\n"
}

$o.= "<address>$config{'wwwaddress'}</address>\n";
$o.= "</body></html>\n";

print $o or die $!;

sub ptitle ($) { length $_[0] ? $_[0] : 'top level'; }

sub printout ($) {
    my ($pt) = @_;
    my ($title,$rurl);
    $title= ptitle($pt);
    $rurl= length $pt ? "$sf/$pt" : $sf;
    $o .= '<h2>';
    if ($pt eq $topic) {
	$o .= $title;
    } else {
	$o .= "<A href=\"$rurl\">$title</A>";
    }
    $o .= "</h2>\n<pre>\n";
    $o .= $lines{$pt};
    $o .= "</pre>\n<hr>\n";
}
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';
38f6943e MW	26	##$sf= $ENV{'SCRIPT_NAME'};
38f6943e MW	27	$sf = "/help";
5e5be903 IJ	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) {
bdf495dc	97	$o .= "See <A href=\"$sf\">top level</A>.\n";
5e5be903 IJ	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	}