#!/usr/local/bin/perl
##############################################################################
# Random Link                   Version 1.0                                  #
# Copyright 1996 Matt Wright    mattw@worldwidemart.com                      #
# Created 7/15/95               Last Modified 7/30/95                        #
# Scripts Archive at:           http://www.worldwidemart.com/scripts/        #
##############################################################################
# COPYRIGHT NOTICE                                                           #
# Copyright 1996 Matthew M. Wright  All Rights Reserved.                     #
#                                                                            #
# Random Link may be used and modified free of charge by anyone so long as   #
# this copyright notice and the comments above remain intact.  By using this #
# code you agree to indemnify Matthew M. Wright from any liability that      #
# might arise from it's use.                                                 #
#                                                                            #
# Selling the code for this program without prior written consent is         #
# expressly forbidden.  In other words, please ask first before you try and  #
# make money off of my program.                                              #
#                                                                            #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium.  In all cases copyright and header must remain intact.#
##############################################################################
# Define Variables

use strict;

my $linkfile = &getlinkfile; 

# Done
##############################################################################

open (LINKS,"<$linkfile") || &error(1);
my @file= <LINKS>;          # inhale file & get # of lines
close (LINKS);
print "Location: $file[int rand scalar @file]\n\n";  # print a random line

exit;

sub getlinkfile {
  my $tag;
  if ($ENV{'QUERY_STRING'}) {
    $tag = "-$ENV{'QUERY_STRING'}";
    $tag =~ s/[^\w\.\-]//g;
  }
  $ENV{'DOCUMENT_ROOT'} =~ /^\/[^\/]+\/[^\/]+\/[^\/]+\/([^\/]+)/;
  chomp(my $username = $1);
  chdir("/usr/home/$username") || &error(2);
  if (($username !~ /^[a-zA-Z0-9]{2,8}$/) || 
      (!-e ".randlink$tag") ||
      (-l ".randlink$tag")) { &error(2); 
  }
  return "/usr/home/$username/.randlink$tag";
}

sub error {
  my $e = shift;
  print "Content-type: text/html \n\n";
  my @msg;
  $msg[1] = "ERROR:  Unable to open random link data file.";
  $msg[2] = "ERROR:  Unable to find random link data file."; 
  if (defined($msg[$e])) { print $msg[$e],"<p>\n"; }
  else { print "An unknown error has occurred.<p>\n"; }
  exit;
}