#! /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 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 "\n"; print "\n"; print "$title"; print "" if $base ne ""; print "\n"; print "\n"; } else { open ( HDR, $header ); while ( ) { 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 ( ) { ++$line; --$start; last if $start <= 0; } /]+>(.*)->/; $title = "$title - $1"; } else { while ( ) { ++$line; last if /

/; } } print "

$title

\n"; # Now read the lines. while ( ) { ++$line; # Stop if we're told to stop. last if /END BOOKMARKS/; # Insert bullets in front of items. s/
\"*\" (Why has Netscape put them in???). next if /^ *
*$/; # Special processing to guarantee HTML 3.2 validation. s/
/

/ if $level == 1; s/

<[pP]>/
/; s/
/

/ if $level > 1; # Get rid of LAST_UPDATED= and other crap which Netscape inserts. s/(A HREF="[^"]+")[^>]*/\1/ if /]+>/

/ if /

/ ) { print if ! /PRIVATE/; } elsif ( /PRIVATE/ ) { &GobbleUp; } elsif ( /->/ ) { s/

/

/; s/

/

\" / if $img_fwd ne ""; s/<\/H3>/<\/A><\/H3>/; s/\s*->[^<]*//; s/

//;s/<\/H3>/<\/B>/; print; &GobbleUp; } else { s/

//;s/<\/H3>/<\/B>/; print; } # Keep track of the level number and quit if we're at the end of # our top-most level. if ( /
/ ) { ++$level;} if ( /<\/DL>/ ) { --$level; last if $level == 1 } } while ( $level > 1 ) { print "
\n"; --$level; } close(IN); # Print the footer. if ( $footer eq "" ) { print "\n"; } else { open ( HDR, $footer ); while ( ) { print; } close ( HDR ); } # --------------------------------------------------------------------- # --- Gobble up lines. sub GobbleUp { $lev = 1; while ( ) { ++$line; if ( /
/ ) { ++$lev; } if ( /<\/DL>/ ) { --$lev; last if $lev == 1 } } ++$level; } # --------------------------------------------------------------------- # --- Print a fatal error message and quit. sub Fatal { local($m) = @_; print "

something went wrong\n"; print "

please mail $email to tell me about it,\n"; print "including the following error message:\n\n"; print "

$m

\n"; die "Aborted"; }