#!/usr/bin/perl
#
# File:     RandomPage.pl
# Author:   Angus McIntyre <angus@pobox.com>
# Date:     03.07.95
# Updated:  25.03.98
#
# ---------------------------------------------------------------------------
#
# EXPLANATION
#
# Chooses a page at random, and jumps to it. This script searches downwards
# recursively through your HTML document tree, picks a page, and sends a
# relocation command to the user's browser, causing them to jump to the
# randomly selected page. You can keep people out of directories that you
# don't want them to jump into by using '.index_control' files (see the
# explanation of the constant $INDEX_CONTROL_FILE below).
#
# The latest version of the script should always be available via:
#
#   http://www.raingod.com/
#
# ---------------------------------------------------------------------------
#
# REVISION HISTORY
#
# 25.03.1998    SLAM    Fixed bug associated with use of 'rand' returning
#                       non-integer values.
# 06.02.1998    SLAM    Extended documentation.
# 13.11.1996    SLAM    Fixed *another* bug in index control. For the
#                       last six months, people have been trampling all
#                       over areas of my site where they weren't wanted.
#                       Aaargh!
# 21.05.1996    SLAM    Fixed bug which meant that index control
#                       didn't work properly. Added explanatory text to
#                       accompany redirect for old/crippled browsers.
# 12.05.1996    SLAM    Added index control features to allow the user
#                       to shut out the random selection process from
#                       certain directories.
# 03.07.1995    SLAM    Implemented.
#
# ---------------------------------------------------------------------------
# LEGAL NOTICE
# 
# This script may be freely copied, distributed and modified. Use  of the 
# script is at the risk of the user. The script is presented "as-is" without 
# any warranty, and the author is not liable for any loss or damages arising 
# out of the use of or failure to use this script. This notice must appear  
# in any modified copy of the script in which the name of the original  
# author also appears.
# ---------------------------------------------------------------------------
#
# INSTALLING THIS SCRIPT
#
# 1. Check the interpreter line - the very first line of this script to be
#    sure that it contains the correct path to your copy of the Perl
#    interpreter. It should begin with '#!' followed by the full path to
#    the interpreter. If you're not sure where Perl is installed, type:
#
#         which perl
#
#    at the shell prompt, or ask your administrator.
#
# 2. Edit the constants below to make sure that they are correctly set up
#    for your system. At a minimum, you will need to change $PAGE_BASE and
#    $URL_BASE.
#
# 3. Make sure that your script is installed in an appropriate place (i.e.
#    the directory where you have installed your other scripts), and has
#    been given the permissions it needs to allow it to be executed as
#    a CGI-bin script.
#
# 4. Reference the script from a Web page with something like:
#
#       <A HREF="/cgi-bin/RandomPage.pl">Click me</A>
#
#    The exact URL you should use will vary from system to system. Ask your
#    administrator for help if in doubt.
#
# ---------------------------------------------------------------------------

# ---------------------------------------------------------------------------
#                                PARAMETERS
# ---------------------------------------------------------------------------

$|=1;                   # Flush output

# ---------------------------------------------------------------------------
#                               CONSTANTS
# ---------------------------------------------------------------------------

# $SEPARATOR: pathname separator character ('/' on UNIX, ':' on MacOS).

$SEPARATOR = '/';

# $PAGE_BASE: path to directory at root of the HTML document tree. This is
# the pathname (not a URL) to the directory in which your HTML documents are
# stored. You can find out the correct path to use (usually, although this
# may not work for some complex filesystems) by changing directory to the
# directory where you keep your HTML files and then typing 'pwd' at the
# shell prompt. If this doesn't work for you, or you don't have shell access,
# ask your administrator.

$PAGE_BASE = "/home/o010o011/public_html/titles/";

# $URL_BASE: string to put at the start of the returned URL. This is the
# URL corresponding to the $PAGE_BASE path above. In other words, it's the
# string that all your URLs start with, typically 'http://' followed by the
# name of your host, another '/', and then (probably) a string identifying 
# your own directory.

$URL_BASE = "http://aug2712.x10.mx/titles/";

# $DIRECTORY_BIAS_FACTOR: Factor determining how likely the routine is
# to choose a directory as opposed to a file at each stage. The smaller
# the number, the deeper the script is likely to go into your directory
# structure and, conversely, the larger the number, the more likely it is
# to show things near the top of your document tree.

$DIRECTORY_BIAS_FACTOR = 5;

# $SCRIPT_NAME: name of this script. If you change this, make sure that your
# references from HTML documents and index control files are also changed
# appropriately.

$SCRIPT_NAME = 'RandomPage.pl';

# $INDEX_CONTROL_FILE: name of a file that controls the operation of
# various index scripts, including this one. To keep this script from
# returning a file within a given directory, place a file called
# '.index_control' at the top level of the directory, and include the
# line 'exclude RandomPage.pl' in it.

$INDEX_CONTROL_FILE = '.index_control';

# ---------------------------------------------------------------------------
#                             MAIN ROUTINE
# ---------------------------------------------------------------------------

# Seed the random number generator and call the main routine.

srand;

do return_url(do process_directory($PAGE_BASE));

# ---------------------------------------------------------------------------
#                           SUBROUTINES
# ---------------------------------------------------------------------------

# process_directory
#
# Recursively process a directory

sub process_directory {
    local($directory) = @_;
    local($result,$item,$filename,@items,@chosen,@directories,@files);
    
    # Get all the items in this directory
    
    opendir(DIRECTORY,$directory);
    @items = readdir(DIRECTORY);
    closedir(DIRECTORY);

    # Sort the list of items into directories and files. Discard any
    # files that aren't HTML documents, and discard any directories
    # that begin with '.' (on my system, these hold images, templates,
    # scripts etc., which we don't want the user to jump to). If you
    # delete this test, remember that you'll also be letting in the
    # '.' and '..' directories, which could cause your script to loop
    # endlessly on UNIX systems. The test also checks to see if the
    # directory in question can be used, or if there is an explicit
    # prohibition against it in the form of an index-control file. 
    
    foreach $item (@items) {
        $filename = $directory . $item;
        $extension = substr($item,(rindex($item,".")+1));
        push(@directories,$filename) 
            if (-d $filename && 
                   $item !~ /^\./ &&
                   &can_use_directory_p($filename));
        push(@files,$filename) if (-f $filename && $extension eq "html");
    }

    # If there are some files to choose from, and either there are no
    # directories, or we randomly choose in favour of selecting a file
    # in the present directory, then pick a file at random and return
    # it.
    
    if (@files && (!@directories || int(rand($DIRECTORY_BIAS_FACTOR)) == 0)) {
        return $files[rand(scalar(@files))];
    }
    
    # Otherwise loop through the directories. Pick one at random, and go
    # down into it, looking for a suitable file. If you get a non-null
    # result, return it, otherwise discard that directory and try the
    # next one in the list.
    
    else {
        while(@directories) {
            @chosen = splice(@directories,int(rand(scalar(@directories))),1);
            $result = do process_directory($chosen[0] . $SEPARATOR);
            return $result if $result;
        }
        
        # If we run out of directories, return null.
        
        return ();
    }
}

# can_use_directory_p
#
# Check whether a directory has an index control file in it and, if so,
# whether this script is among those excluded by it.

sub can_use_directory_p {
    local($directory) = @_;
    local($path) = $directory . $SEPARATOR . $INDEX_CONTROL_FILE;
    local($can_use_p) = 1;
    if (-e $path && (open(FILE,$path))) {
        while (<FILE>) {
            $can_use_p = 0, last if /exclude $SCRIPT_NAME/;
        }
        close(FILE);
    }
    $can_use_p;
}

# return_url
#
# Print out a redirection. Turn the pathname into a URL by a little
# crude munging. The redirect is also accompanied by a bunch of
# HTML text that is provided for those browsers that don't handle
# redirection properly.

sub return_url {
    local($file) = @_;  
    local(@elements) = split($SEPARATOR,
                             substr($file,length($PAGE_BASE)));
    local($redirect) = $URL_BASE . join("/",@elements);
    print <<"EndOfHTML";
Content-type: text/html
Location: $redirect

<HTML>
<HEAD>
<TITLE>Redirection</TITLE>
</HEAD>
<BODY>
<H1>Redirection</H1>
<P>It appears that your browser cannot handle redirections
automatically. You can proceed to the randomly-selected page 
by clicking <A HREF="$redirect">here</A>.</P>
</BODY>
EndOfHTML
}