#!/usr/bin/perl -Tw
use strict;
delete @::ENV{qw(IFS PATH CDPATH ENV BASH_ENV)};

package select;

use CGI;
use CGI::Carp qw(fatalsToBrowser);

# select.cgi
# ~~~~~~~~~~
# Provides a page containing multiple frames, each of which contains
# one of the web pages specified in the arguments. If the browser is
# not supporting frames, the page returned just contains links to the
# specified web pages.
#
# Useful for things like searching multiple web search engines at the
# same time with a much thinner software layer (and hence better
# response time) than things like savvy or metacrawler.
#
# See http://www.zip.com.au/~raf2 for an example of its use.
#
# 1997/10/2 raf <raf@raf.org>
#
# Invocation
# ~~~~~~~~~~
#  <form action="http://cgi.zip.com.au/raf2/select.cgi" method=post>
#    <!--
#      Input "set" is mandatory. It contains a comma/space separated
#      list of the input names below whose values are the urls to display.
#      The user selects the urls to display and select.cgi traverses "set",
#      looking for inputs with the same names. The ones present are those
#      selected by the user.
#
#      Note: The order in which names appear in "set" determines the
#      order in which the frames will appear.
#    -->
#
#    <input type=hidden name=set value="url1, url2, url3">
#
#    <!--
#      Input "title" is optional. It is used to specify the title of
#      the resulting page. The default title is "select.cgi".
#    -->
#
#    <input type=hidden name=title value="MyTitle">
#
#    <!--
#      Input "error" is optional. It is used to specify a user-defined
#      error url. If not defined, error pages are generated internally.
#      If defined, the error url is composed of the user supplied value
#      for the 'error' input, followed by:
#
#          "?err=N", or
#          "?err=N&amp;name=AAAA"
#
#      where N is the error code:
#
#          1 = Parrameter missing
#          2 = No selections made
#          3 = Undefined layout
#
#      and AAAA is the name of the missing parameter or undefined layout.
#    -->
#
#    <input type=hidden name=error value="http://cgi.zip.com.au/raf2/select-error.cgi">
#
#    <!--
#      Input "fork" is optional. It causes the selection to appear
#      in a new browser window.
#    -->
#
#    <input type=checkbox name=fork value=yes checked>
#
#    <!--
#      This is an example of a normal form input variable that will be
#      used parametrically in one of the 'real' inputs (i.e. those
#      mentioned in input "set"). Inputs not mentioned in "set" are ignored
#      by select.cgi unless they are indirectly used by inputs that are
#      mentioned in "set".
#    -->
#
#    <input type=text name=input size=35 value="">
#
#    <!--
#      Here are the url inputs. Their names must appear in "set". If the
#      value contains any patterns of the form: "\$[_a-zA-Z][_a-zA-Z0-9]*"
#      then select.cgi looks for the input with the name in the pattern.
#      The value of that input is substituted into this input value after
#      translating all of the interesting characters into hexadecimal so
#      it remains a valid url.
#    -->
#
#    <table border=0>
#      <tr>
#        <td>
#          <input
#            type=checkbox
#            name=url1
#            value="http://www.blerk.com/cgi-bin/query?q=$input"
#            checked
#          >
#          url1
#        </td>
#        <td>
#          <input
#            type=checkbox
#            name=url2
#            value="http://www.fnord.edu/cgi-bin/blotch?k=$input"
#          >
#          url2
#        </td>
#        <td>
#          <input
#            type=checkbox
#            name=url3
#            value="http://www.evil.gov/cgi-bin/grunt?urgh=$input"
#          >
#          url3
#        </td>
#      </tr>
#
#      <!--
#        Here is the layout menu. The choices are "horizontal", "vertical"
#        and "grid". The layout menu is optional. The default layout is
#        "horizontal". And, of course, the submit and reset buttons.
#      -->
#
#      <tr>
#        <td>
#          <select name=layout>
#            <option value=horizontal>horiz
#            <option value=vertical>vert
#            <option value=grid selected>grid
#          </select>
#        </td>
#        <td>
#          <input type=submit name=submit value=Search>
#        </td>
#        <td>
#          <input type=reset name=reset value=Clear>
#        </td>
#      </tr>
#    </table>
#  </form>

#
# Error codes and messages.
#

my $error;
sub ERR_MISSING_PARAMETER { return 1; }
sub ERR_NOTHING_SELECTED { return 2; }
sub ERR_NO_SUCH_LAYOUT { return 3; }
my @error =
(
	'',
	'Parameter missing: ',
	'No selections made.',
	'Undefined layout: '
);

cgi:
{
	print fill(selection(), params());
	exit(0);
}

#
# Build the parameter list for the HTML template below.
#

sub params
{
	my $cgi = new CGI;

	my %params =
	(
		'Header' => 'Content-type: text/html',
		'Title' => 'select.cgi',
		'Frames' => '',
		'NoFrames' => ''
	);

	#
	# Set the title.
	#

	$params{'Title'} = $cgi->param('title')
		if (defined($cgi->param('title')));

	#
	# Get any user defined error urls.
	#

	if (defined($cgi->param('error')))
	{
		$error = $cgi->param('error');
	}

	#
	# Get the choices (from 'set') that have been selected.
	#

	my @choices;

	if (defined($cgi->param('set')))
	{
		my $choice;

		for $choice (split(/[,\s]+/, $cgi->param('set')))
		{
			push(@choices, evaluate_choice($cgi, $choice))
				if (defined($cgi->param($choice)));
		}
	}
	else
	{
		fail($cgi, ERR_MISSING_PARAMETER(), 'set');
	}

	#
	# If nothing was selected, go beserk.
	#

	# redirect back to referer?

	fail($cgi, ERR_NOTHING_SELECTED()) if ($#choices == -1);

	#
	# If there's only one selected, just go there.
	#

	redirect($cgi, $choices[0]) if ($#choices == 0);

	#
	# Get the layout to use.
	#

	my $layout = 'horizontal';

	$layout = $cgi->param('layout')
		if (defined($cgi->param('layout')));

	my %strategy =
	(
		'horizontal' => \&horizontal,
		'vertical' => \&vertical,
		'grid' => \&grid
	);

	if (defined($strategy{$layout}))
	{
		my $strategy = $strategy{$layout};

		($params{'Columns'}, $params{'Rows'}) = &$strategy($#choices + 1);
	}
	else
	{
		fail($cgi, ERR_NO_SUCH_LAYOUT(), $layout);
	}

	#
	# Build the selection frames and links.
	#

	my $choice;

	for $choice (@choices)
	{
		$params{'NoFrames'} .= mk_link($choice);
		$params{'Frames'} .= mk_frame($choice);
	}

	#
	# Provide results in a separate browser window?
	#

	if (defined($cgi->param('fork')))
	{
		$params{'Header'} .= "\n" . 'Window-target: ' . $$;
	}

	return %params;
}

#
# Evaluate all '$' parameters in the selected url. Result is a url.
# Note: Evaluation may nest. Nested evaluation is breadth first.
#

sub evaluate_choice
{
	my ($cgi, $choice) = @_;

	my $arg = $cgi->param($choice);

	while ($arg =~ /(\$\w+)/)
	{
		my $var = substr($1, 1); # strip off '$' to get var name

		if (defined($cgi->param($var))) # did the user select this?
		{
			my $value = CGI::escape($cgi->param($var));
			$arg =~ s/\$$var/$value/g; # evaluate var to value
		}
		else
		{
			fail($cgi, ERR_MISSING_PARAMETER(), $var);
		}
	}

	return $arg;
}

#
# Provides an error page.
#

sub fail
{
	my ($cgi, $err, $name) = @_;

	if (defined($error))
	{
		my $errarg = '?' . 'err=' . $err;
		$errarg .= '&amp;' . 'name=' . $name if (defined($name));

		redirect($cgi, $error . $errarg);
	}
	else
	{
		my $errmsg = $error[$err];
		$errmsg .= ' ' . $name if (defined($name));
		my $target = '';

		if (defined($cgi->param('fork')))
		{
			$target = "\n" . window();
		}

		print failure($target, $errmsg);
	}

	exit(0);
}

#
# Provides redirection to another page.
#

sub redirect
{
	my ($cgi, $url) = @_;

	print 'Location: ', $url;

	if (defined($cgi->param('fork')))
	{
		print "\n", window();
	}

	print "\n\n";

	exit(0);
}

#
# Horizontal layout strategy: 1 column, n rows.
#

sub horizontal
{
	my ($num) = @_;

	return ('*', stars($num));
}

#
# Vertical layout strategy: n columns, 1 row.
#

sub vertical
{
	my ($num) = @_;

	return (stars($num), '*');
}

#
# Grid layout strategy: p columns, q rows where p and q are
# nearest factors of n (number of choices selected by the user).
# The bias is towards horizontal.
#

sub grid
{
	my ($num) = @_;

	my ($cols, $rows) = nearest_factors($num);

	return (stars($cols), stars($rows));
}

#
# Calculate the nearest factors of $num. Highest first.
#

sub nearest_factors
{
	my ($num) = @_;
	my ($f1, $f2);

	for ($f1 = int(sqrt($num));; --$f1)
	{
		$f2 = $num / $f1;
		last if ($f2 == int($f2));
	}

	return ($f1, $f2);
}

#
# Generate a string of $num comma separated asterisks.
# For use in frame tags when specifying rows and columns.
#

sub stars
{
	my ($num) = @_;

	return '*' . ',*' x ($num - 1);
}

#
# Make a hyperlink to a selection for frameless browsing.
# Link text is the url without any cgi parameters.
#

sub mk_link
{
	my ($src) = @_;
	my $link = $src;
	$link =~ s/\?.*$//;

	return "<br>\n<br>\n\t<a href=\"$src\">$link</a>\n";
}

#
# Make a frame for a selection.
#

sub mk_frame
{
	my ($src) = @_;

	return "\t<frame src=\"$src\" marginwidth=1 marginheight=1 scrolling=auto>\n";
}

#
# Returns http target directive to place response in a separate browser window.
#

sub window
{
	return 'Window-target: ' . time() . '-' . $$;
}

#
# Replace '@@Parameters@@' in the $template with corresponding values in %arg.
#

sub fill
{
	my ($template, %arg) = @_;
	my $arg;

	for $arg (keys %arg)
	{
		$template =~ s/\@\@$arg\@\@/$arg{$arg}/g;
	}

	return $template;
}

#
# HTML template for a selection.
#

sub selection
{
	return << 'SELECTION';
@@Header@@

<!doctype html public "-//W3C//DTD HTML 3.2//EN">
<html>
<head>
<title>
@@Title@@
</title>
</head>
<frameset rows="@@Rows@@" cols="@@Columns@@">
@@Frames@@
<noframe>
<body>
@@NoFrames@@
</body>
</noframe>
</frameset>
</html>
SELECTION
}

#
# HTML template for default error page.
#

sub failure
{
	my ($target, $errmsg) = @_;

	return << "FAILURE";
Content-type: text/html$target

<!doctype html public "-//W3C//DTD HTML 3.2//EN">
<html>
<head>
<title>
error: select.cgi
</title>
</head>
<body>
<strong>
<font size="+1">
error in select.cgi
</font>
</strong>
<hr width="100" align=left>
$errmsg
<br>
<br>
Try
<a href="$ENV{'HTTP_REFERER'}">again</a>?
Bug
<a href="mailto:raf2\@zip.com.au">report</a>?
</body>
</html>
FAILURE
}