#!/usr/local/bin/perl
#    Time-stamp: "2005-08-19 01:25:00 ADT" sburke@cpan.org
# desc{ browse ircII docs as HTML }
# ------------------------------------------------------------
# This package is Copyright 1996- by Sean M. Burke, sburke@cpan.org
#
# irc2html
#
# Synopsis:
#  irc2html is a CGI script which makes ircII documentation files
#  readable thru a hypertext interface, thru the Web.
#
# Author:
#  Sean M. Burke, sburke@cpan.org
#
# Requirements, Bugs, and Caveats:
#  You have to have the ircII docs on the same filesystem as the httpd.
#  You have to configure the following variables, marked "Config"
#
# Availability & Copying:
#
# irc2html is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any
# later version.
#
# irc2html is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# To see a copy of the GNU General Public License, see
# http://www.ling.nwu.edu/~sburke/gnu_release.html, or write to the
# Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
# ------------------------------------------------------------

############################## CONFIG ##############################

$my_url_path= $ENV{'SCRIPT_NAME'} . '/';
	#path to this cgi-bin script, plus a slash

$about_path='http://www.ling.nwu.edu/~sburke/irc2html.html';
	#path to more info on these docs

$irc_help_path='/home/babel/sburke/.bin/IRC/help/';
	#path to the IRC docs.  Must be slash-terminated

$up_button = "[<A HREF=\"$my_url_path\">Up to Main</A>]<BR>";
        #what to print as a button to go to the root of the help tree

$tag = "[<A HREF=\"$about_path\">More</A>] about these docs<BR>sburke\@cpan.org</BODY></HTML>";

#### End of config #########################################################
#

#don't mess with these
@rfc882_months =  ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug",
		   "Sep", "Oct", "Nov", "Dec");
@rfc882_days = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" );

$file2get = $ENV{'PATH_INFO'};
 # PATH_INFO is what's after the script name in a URL in the form
 # http://machine/aliaspath/thisscript/foo/bar/baz
 # There, for example, it'd be /foo/bar/baz

$file2get =~ s/^\///;	#pull slash off the front

$file2get =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	#unpack any %-quoting
$literal_file2get = $irc_help_path . $file2get;

if (-d $literal_file2get) {

    $file2get .= '/' if ($file2get ne '' && $file2get =~ /[^\/]$/);
    # add a slash if it's not already there

    $top = $file2get eq '/' || $file2get eq '' ? 1 : 0;

    if (opendir(DIR,$literal_file2get)) {
	print "Content-type: text/html\nLast-Modified: " . &last_revised($literal_file2get) . "\n\n";

	if ($top) {
	    print <<"EOF";
<HTML><HEAD><TITLE>Documentation for ircII</TITLE>
<META NAME="Description" CONTENT="documentation for ircII">
<META NAME="Keywords" CONTEN="ircii, ircII, documentation, irc">
</HEAD><BODY>
<H1>Documentation for ircII</H1>Choose from these subsections:<UL>
EOF

	} else {
	    print <<"EOF";
<HTML><HEAD><TITLE>irc docs: $file2get</TITLE></HEAD><BODY>
<H1>irc docs: $file2get</H1>Choose from these subsections:<UL>
EOF

	}
	foreach $file (grep(!/^\./,sort(readdir(DIR)))) {
	    # the grep (grep(!/^\./,foo) kills the dot files and . and ..

	    $file .= '/' if (-d ($literal_file2get . $file) );

	    $url2there= $my_url_path . $file2get . $file;
	    $url2there =~ s/([%=\;#?: !*"'()])/'%'.(unpack("H2",$1))/eg;
	    # this %-escapes stuff
	    # the things I'm unescaping I got from the URL spec at
	    # http://www.w3.org/hypertext/WWW/Addressing/URL/5_BNF.html
	    print "<LI><A HREF=\"$url2there\">$file</a>\n";
	}
	closedir(DIR);
        print "</UL><HR>\n";
        print "$up_button" unless ($file2get eq "");
        print "$tag</BODY></HTML>";

    } else { 
	print "Content-type: text/html\nStatus: 404 Not Found\n\n";
	print "<HTML><HEAD><TITLE>No object</TITLE></HEAD><BODY>No such directory as $literal_file2get\n<HR>$tag</BODY></HTML>";
    }

} else {

    #We gotta open a file
    if (open (IN, $literal_file2get ) ) {
	print "Content-type: text/html\nLast-Modified: " . &last_revised($literal_file2get) . "\n\n";

	print "<HTML><HEAD><TITLE>irc docs: $file2get</TITLE></HEAD><BODY>
<H2>$file2get</H2><PRE>";

	while (<IN>) {
	    s/\&/&amp;/g;
	    s/\</&lt;/g;
	    s/\>/&gt;/g;
	    s/\cb([^\cb]*)\cb/<B>$1<\/B>/g;
	    s/\cv([^\cv]*)\cv/<I>$1<\/I>/g;
	    #other s's here.

	    #$hottext = $_;
	    s/\c_HELP\c_/HELP/g;
	    #'cause of some stupid things in the form ^_HELP^_ ^_SET^_ ^_BIND^_
	    # which should be ^_SET^_ ^_BIND^_

	    s/\c_([^ \c_]*)\c_ \c_([^ \c_]*)\c_/<A HREF=\"$my_url_path$1\/$2\">$1 $2<\/A>/g;
	    # for things in the form  ^_SET^_ ^_BIND^_

	    s/\c_([^ \c_]*)\c_/<A HREF=\"$my_url_path$1\">$1<\/A>/g;
	    # for things in the form  ^_SERVER^_

	    print $_ ;
	}
        print "</PRE><HR>\n$up_button$tag</BODY></HTML>";
	close (IN);

    } else {
	#couldn't find the file: give an error
	close (IN);
	print "Content-type: text/html\nStatus: 404 Not Found\n\n";
	#print "No such directory as $literal_file2get\n<HT>$tag";
	print "<HTML><HEAD><TITLE>Error: No Object</TITLE></HEAD><BODY>
<H2>Error: No Object</H2>
No such file as $literal_file2get
<HR>$tag</BODY></HTML>";

    }
}

0;				# end

######################################################################

sub last_revised {
 #get the last revised date of the given filespec
    local(@junk);
    @junk = stat($_[0]);
    return &rfc822_time($junk[9]);
}

######################################################################
sub rfc822_time{
    local(@gmt);
    @gmt = gmtime($_[0]);
    $gmt[5] += 1900;
    # $gmt[5] += 100 if ($gmt[5] < 1970);

    return join(' ', $rfc882_days[$gmt[6]] . ',', sprintf('%02d', $gmt[3]),
	   $rfc882_months[$gmt[4]], $gmt[5], sprintf('%02d', $gmt[2]) . ':' .
	   sprintf('%02d', $gmt[1]) . ':' . sprintf('%02d', $gmt[0]), 'GMT');

}

## End ############################################################
