#!/usr/bin/perl
# Name: pickurl.pl
# Purpose: This is a cgi script which sends a user to
# a new URL based on their choice from a input selection
#
# Usage: This script is portable. You can use this with
# any web page that sets up the input selections as
# below. This script is not specific to any particular
# page.
#
# The URLs you want the user to go to must be passed as
# values from the HTML. In order to do this, the HTML
# author must include the appropriate URLs as the values
# for the selection options.
#
# NOTE: Absolute pathnames must be used, not just
# foo.html, but rather http://www.bar.com/foo.html
#
# Example: I want to offer a pull-down menu selection of
# pages that a user can jump to. The pages are titled
# Moe's Home Page, Larry's Home Page and Curly's Home
# Page. The actual HTML filenames are moe.html and so on,
# and they are in the home directory
# (i.e. http://www.stooges.com/*). Sooooo, our HTML should
# look like this:
#
#
#
# Note that for the SELECT tag, the NAME must be "user_options"
#
# And it's as easy as that!
#
#
# More Details: Ok, it's not *quite* as easy as that....
#
# 1) Make sure the correct perl pathway is in the first line
# of the script
#
# 2) You might need to change extension on this script from
# ".pl" to ".cgi", depending on your server's configuration.
#
# 3) Also, you might need to place this script in your
# bin or cgi-bin directory, depending upon on your server's
# configuration.
#
# 4) If you place this script in a directory other than the
# one where the HTML file is, you need to include the correct
# pathname in the HTML form. Thus, if the script resides in
# a cgi-bin directory, instead of ACTION="pickurl.pl", you'd
# write ACTION="http://www.stooges.com/cgi-bin/pickurl.pl"
#
# 5) Most likely, you can ask for help from the person(s)
# that set up and/or manages the web server software; they
# can help you figure out your specific situation.
#
# 6) Think good thoughts. It can't hurt.
#
#
#
# Script created by:
# Imagesmith
# http://www.imagesmith.com/imagesmith/
# imagesmith@slugs.com
#
#
# check and see if the POST method was used. If so,
# things should be dandy. We get the info from the
# cgi standard input; if not we burp and error
if ($ENV{"REQUEST_METHOD"} eq "POST")
{
# read the input off of standard input
read(STDIN, $data, $ENV{"CONTENT_LENGTH"});
# using parseform, place values into associative
# array with variables as keys and values (i.e. the URL)
# as...values
%form_values = &parseform($data);
}
else
{
print "Content-Type: text/html\n";
print "\n";
print (<<"BadResponse"
Form Error!Congratulations!
You have encountered an error!
Please return to the previous page and try again,
or contact the administrator of the site.
Good luck!
BadResponse
);
exit;
};
# These next lines are for debugging
#
# print "Content-Type: text/html\n";
# print "\n";
# print "The value of the data is $data.\n";
# print "The url to be returned is $form_values{user_options}";
#
#
# Based on the user's choice, return a URL
#
if ($form_values{user_options})
{
print "Location: $form_values{user_options}\n\n";
}
else
{
print "Content-Type: text/html\n";
print "\n";
print (<<"BadResponse"
Form Error!Congratulations!
You have encountered an error!
Please return to the previous page and try again,
or contact the administrator of the site.
Good luck!
BadResponse
);
exit;
};
exit;
# This subroutine takes a url-encoded string and
# turns it into an associative array.
sub parseform
{
local($formthing) = @_;
# Expects something like:
# foo=wow%21&bar=hello&baz=blah
# Split the string into each of the key-value pairs
(@fields) = split('&', $formthing);
# For each of these key-value pairs, decode the value
for $field (@fields)
{
# Split the key-value pair on the equal sign.
($name, $value) = split('=', $field);
# Change all plus signs to spaces. This is an
# remnant of ISINDEX
$value =~ y/\+/ /;
# Decode the value & removes % escapes.
$value =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig;
# Create the appropriate entry in the
# associative array lookup
if(defined $lookup{$name})
{
# If there are multiple values, separate
# them by newlines
$lookup{$name} .= "\n".$value;
}
else
{
$lookup{$name} = $value;
}
}
# Return the associative array
%lookup;
}