!/usr/bin/perl

#-------------------------Welcome-----------------------------
#
# ClickGo 
# Ver. 1.1.2
# By Luke and Mark Pfeifer
# http://www.staff.net/cgi-scripts/		
# Released 5-7-97
# Updated  12-30-97
#
# Copyright Info: This application was written by Mark and Luke
# Pfeifer. Feel free to copy, cite, reference, sample, borrow 
# or plagiarize the contents.  However, if you don't mind,
# please let us know where it goes so that we can watch and take
# part in the development of it. Information wants to be free,
# support public domain freeware.  Donations are appreciated
# and will be spent on further upgrades and other public domain
# scripts.
#
# Finally, PLEASE SEND WORKING URL's to scripts@staff.net.
# We would like to keep a list of these scripts in use.
#-------------------------------------------------------------

#-----------------------Version History--------------------------
#
# Version 1.0	- 5-7-97	- Orginal Version Created
#
# Version 1.1	- 7-19-97	- Now works with IIS (Internet
#				  Infromation Server) and PWS
#				  (Personal Web Server)
#				- Allows linking via protocols
#				  other than HTTP, like FTP
#
# Version 1.1.1	- 7-29-97	- Better way to handle IIS
#				- Do not need $iis configuration
#				  variable any more
#
#
# Version 1.1.2	- 12-30-97	- Fixed header for Unix Scripts
#							- Fixed syntax error with older
#								versions of Perl
#
#-------------------------------------------------------------

#-----------------------ReadMe--------------------------------
#
# This script now works with IIS (Internet Infromation Server)
# and PWS (Personal Web Server)!  And also with Unix Servers!
#
# This script requires that PERL is loaded on your web server
# and that the web server is configured to run PERL scripts as
# CGI scripts.
#
# Configure the script in the User Configuration section below.
#
# Upload this file to your CGI directory on your web server in
# ASCII mode.  If you do not know if you have a CGI directory,
# ask your web server administrator.
#
# Chmod this file to 755, if you have Unix.
#
# The script is called by creating a link like this
#   <form method="post" action="file:///more%20awesome/tinkmar2000/sample/clickgo.pl"> 
#		<select name="goto" size="1"><option value="/Indecies/1920-fs.html" selected>1920s</option><option value="/Indecies/1930-fs.html">1930s</option></select>	
#  <input type="submit" value="GO" name="Submit">
#	</form>
# # Notes on above example: # # - You need to change the action of the form to 
use the # clickgo.pl script that you uploaded to your server # # - The option 
values that are used in the HTML form can # contain the protocol name (i.e. http://, 
ftp://, etc). # If they do not, the HTTP protocol will be assumed. # #------------------------------------------------------------- 
# #--------------- Variable Definition -------------------------- # # $main - 
the url of the default page to go to if there is no # url specified when the script 
is executed # #------------------------------------------------------------- #-------Start 
User Configuration ---------------------------- $main = 'http://www.asci4d.com/sitejuly/try.html'; 
#---End User Configuration ----------------------------------- #**************** 
DO NOT EDIT PAST THIS LINE *****************# &FormInput(*input); if($input{'goto'} 
eq "") { print "HTTP/1.0 302 Temporary Redirection\r\n" if $ENV{PERLXS} eq "PerlIS"; 
print "Content-type: text/html\n"; print ("Location: $main\n\n"); } else { if 
($input{'goto'} !~ m?://?) { $input{'goto'} = "http://" . $input{'goto'}; } print 
"HTTP/1.0 302 Temporary Redirection\r\n" if $ENV{PERLXS} eq "PerlIS"; print "Content-type: 
text/html\n"; print ("Location: $input{'goto'}\n\n"); } exit; #------------------------------------------------------------- 
# FormInput: Function #------------------------------------------------------------- 
sub FormInput { local (*qs) = @_ if @_; if ($ENV{'REQUEST_METHOD'} eq "GET") { 
$qs = $ENV{'QUERY_STRING'}; } elsif ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN,$qs,$ENV{'CONTENT_LENGTH'}); 
} @qs = split(/&/,$qs); foreach $i (0 .. $#qs) { $qs[$i] =~ s/\+/ /g; $qs[$i] 
=~ s/%(..)/pack("c",hex($1))/ge; ($name,$value) = split(/=/,$qs[$i],2); if($qs{$name} 
ne "") { $qs{$name} = "$qs{$name}:$value"; } else { $qs{$name} = $value; } } return 
1; }