#! /usr/local/bin/perl
#  -------------------------------------------------------------
#  File:	bmarkcgi.pl
#
#  Version:	1.0	29-Nov-96	First release.
#               with a few minor changes by colin moock.
#
#  Author:	Gihan Perera (gihan@pobox.com)
#		First Step Communications
#		29th November, 1996
#
#  Documentation and updates for this program are available at:
#
#     http://www.firststep.com.au/software
#
#  Copying and Distribution
#
#     Permission is hereby granted to copy and distribute this program
#     freely, as long as the "Author:" section above is retained. Since
#     this is provided free of charge, it comes with no warranty nor
#     guarantee of fitness for purpose.
#
#     In the spirit in which this is given, if you decide to pass this
#     on to others, either in original form or changed, you must not
#     charge any money for doing so.
#
# ---------------------------------------------------------------------

# THINGS YOU NEED TO SET UP

# E-mail address to notify in case of errors. PLEASE change this to
# YOUR e-mail address, not mine!!!
#
# IMPORTANT: You must use a backslash before the '@' symbol in the
# address.

$email = "moockmarks\@moock.org";

# URL of this script.

$url = "/moockmarks/index.pl";

# This is the base directory (specified as a directory on your file
# system, not a URL) where the source files live. It MUST end in '/'.

$dir = "/wwwroot/moock.org/moockmarks/";

# Name of the bookmarks file (relative to $dir).

$bookmarks = "bookmark.html";

# Base URL (used in <BASE> tag in default header). You only need
# to provide this if you're using the default header (i.e. you're NOT
# defining your own header.txt) AND you're using $img_dot or $img_fwd
# below.

$base = "http://www.moock.org/moockmarks/";

# Image files for bullet and forward arrow. If you don't want one of
# these, comment out the line.

$img_dot = "moockmarks-bullet.gif";
$img_fwd = "moockmarks-fwd.gif";

# Title to be used for page - only required if you're NOT using your
# own header.txt.

# $title = "moockmarks";

# ---------------------------------------------------------------------

# Internal configuration.

$infile = $dir . $bookmarks;
$header = $dir . "moockmarks-header.txt";
$footer = $dir . "moockmarks-footer.txt";

$header = "" if ! -r $header;
$footer = "" if ! -r $footer;

# ---------------------------------------------------------------------

    print "Content-type: text/html\n\n";

    &Fatal("Can't read bookmarks file $infile") if ! -r $infile;

    open(IN, $infile);

#   Print the header information.

    if ( $header eq "" )
    {
	print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2//EN\">\n";
	print "<HTML>\n";
	print "<HEAD><TITLE>$title</TITLE>";
	print "<BASE HREF=\"$base\">" if $base ne "";
	print "</HEAD>\n";
	print "<BODY BGCOLOR=\"#ffffff\">\n";
    }
    else
    {
	open ( HDR, $header );
	while ( <HDR> ) { print; }
	close ( HDR );
    }

    $line = 0;
    $level = 1;

#   If a starting position is given, find it. Else, skip the header stuff.

    $start = $ENV{'QUERY_STRING'} + 0;

    if ($start > 0)
    {
	while ( <IN> )
	{
	    ++$line;
	    --$start;
	    last if $start <= 0;
	}
	/<H3[^>]+>(.*)->/;
	$title = "$title - $1";
    }
    else
    {
	while ( <IN> )
	{
	    ++$line;
	    last if /<H1>/;
	}
    }
    print "<H3>$title</H1>\n";

#   Now read the lines.

    while ( <IN> )
    {
	++$line;

#	Stop if we're told to stop.

	last if /END BOOKMARKS/;

#	Insert bullets in front of items.

	s/<DT><A/<DT><img src=\"$img_dot\" alt=\"*\"> <A TARGET=\"_blank\"/ if $img_dot ne "";

#	Get rid of lines with just <DD> (Why has Netscape put them in???).

	next if /^ *<DD> *$/;

#	Special processing to guarantee HTML 3.2 validation.

	s/<DD>/<P>/ if $level == 1;
	s/<DL><[pP]>/<DL>/;

	s/<DL>/<DD><P><DL>/ if $level > 1;

#	Get rid of LAST_UPDATED= and other crap which Netscape inserts.

	s/(A HREF="[^"]+")[^>]*/\1/ if /<A HREF=/;
	s/<H3[^>]+>/<H3>/ if /<H3/;

#	Compress multiple newlines into just one, then delete blank lines.

	s/\r//g;
	s/\n+/\n/g;
	next if /^\s*\n*$/;

	if ( ! /<DT><H3>/ )
	{
	    print if ! /PRIVATE/;
	}
	elsif ( /PRIVATE/ )
	{
	    &GobbleUp;
	}
	elsif ( /->/ )
	{
	    s/<H3>/<H3><A HREF=\"$url?$line\">/;
	    s/<H3>/<H3><img src=\"$img_fwd\" alt=\" \"> / if $img_fwd ne "";

	    s/<\/H3>/<\/A><\/H3>/;
	    s/\s*->[^<]*//;
	    s/<H3>/<B>/;s/<\/H3>/<\/B>/;
	    print;
	    &GobbleUp;
	}
	else
	{
	    s/<H3>/<B>/;s/<\/H3>/<\/B>/;
	    print;
	}

#	Keep track of the level number and quit if we're at the end of
#	our top-most level.

	if ( /<DL>/   ) { ++$level;}
	if ( /<\/DL>/ ) { --$level; last if $level == 1 }
    }

    while ( $level > 1 )
    {
	print "</DL>\n";
	--$level;
    }
    close(IN);

#   Print the footer.

    if ( $footer eq "" )
    {
	print "</BODY></HTML>\n";
    }
    else
    {
	open ( HDR, $footer );
	while ( <HDR> ) { print; }
	close ( HDR );
    }

# ---------------------------------------------------------------------

# --- Gobble up lines.

sub GobbleUp
{
    $lev = 1;
    while ( <IN> )
    {
	++$line;
	if ( /<DL>/   ) { ++$lev; }
	if ( /<\/DL>/ ) { --$lev; last if $lev == 1 }
    }
    ++$level;
}

# ---------------------------------------------------------------------

# --- Print a fatal error message and quit.

sub Fatal
{
   local($m) = @_;

   print "<p><strong>something went wrong</strong>\n";
   print "<p>please mail <a href=\"$email\">$email</a> to tell me about it,\n";
   print "including the following error message:\n\n";
   print "<p align=center>$m</p>\n";
   die "Aborted";
}
