#!/usr/local/bin/perl -T

# link.cgi
#
# version 0.1
#
# Copyright 2002 Nathan J. Mehl
# Released under the terms of the General Public License, v2.0
#

# modules
use CGI qw/:standard *table/;


# basic workflow:
# 
# if invoked with no arguments, present a form to generate a key

if ( ! param ) {

	print 
		header,
		start_html('Generate a Short Link'),
		h1('Generate a short link'),
		hr,
		start_form,
		"Enter the long URL:",p,
		textfield(-name=>'url',-size=>80)," ",
		#submit(-name=>'frobnosticate!'),
		"<INPUT TYPE=image BORDER=0 HALIGN=CENTER ALT=\"submit\" SRC=\"greenguy.jpg\">",
		end_form,
		end_html;
	
} elsif ( param('q') eq "list" ) {

	# if invoked with the "list" key, dump the db

	dbmopen(%URLS,'/project/web/htdocs/blank.org/link/urls',0222)
		or die "Can't open url db file! $!";

	print header,
		start_html('List of short links so far...'),
		h1('List of Short links so far...'),
		"...click at your own risk. :-)",p,
		start_table;

#	while (($key,$val) = each %URLS) {
#		print "<tr>";
#		print "<td> <a href=\"http://blank.org/link?q=$key\">$key</a> </td>";
#		print "<td> <a href=\"$val\">$val</a> </td>";
#		print "</tr>\n";
#	}

	foreach $key (sort(keys %URLS)) {
		print "<tr>";
		print "<td> <a href=\"http://blank.org/link?q=$key\">$key</a> </td>";
		print "<td> <a href=\"$URLS{$key}\">$URLS{$key}</a> </td>";
		print "</tr>\n";
	}


	print end_table;
	print end_html;

	dbmclose(%URLS);

} elsif ( param('url') ) {

	# if invoked with a url, build a short link

	my $longurl = param('url');

	if ( $longurl =~ /blank.org\/link/i ) {
		print header,
			start_html('stop that!'),
			h1('Ahem.'),hr,
			"Please don't try to link me to myself.",p,
			"Try <a href=\"http://blank.org/link/\">again</a>.",
			end_html;
		exit 0;
	}

	if ( ! ($longurl =~ /^http:\/\// ) ) {
		print header,
			start_html('oops'),
			h1('Try again..'),hr,
			"Links must begin with \"http://\".  Try
			<a href=\"http://blank.org/link/\">again</a>.",
			end_html;
		exit 0;
	}

	dbmopen(%URLS,'/project/web/htdocs/blank.org/link/urls',0622)
		or die "Can't open url db file! $!";

	my $key = time;
	while ( defined($URLS{$key}) ) {
		$key++;
	}

	$URLS{$key} = $longurl;

	# tell them what the link is
	print
		header,
		start_html('New Link Generated'),
		h1('New Link Generated'),
		hr,
		"Your new link is:",p,
		"<a href=\"http://blank.org/link/?q=$key\">
		http://blank.org/link/?q=$key</a>",p,
		end_html;

	dbmclose(%URLS);

} elsif ( param('q') ) {

	dbmopen(%URLS,'/project/web/htdocs/blank.org/link/urls',0222)
		or die "Can't open url db file! $!";

	my $key = param('q');
	# if invoked with a key, build a redirect page to that key's URL
	if ( defined($URLS{$key}) ) {

		print header,
			start_html(-head=>meta({	-http_equiv=>'refresh',
								-content=>"2\;
								url=$URLS{$key}"}),
					'blank.org short link redirector'
					),
			h1('Blank.Org Short Link Redirector'),
			hr,
			"You are being redirected to <a href=\"$URLS{$key}\">
			$URLS{$key}</a>.",
			end_html;

	} else {
		
		my $key = param('q');
		print
			header,
			start_html('blank.org short link redirector'),
			h1('Sorry...'),
			hr,
			"We\'re sorry, we don\'t have any such link $key in our
			database.",
			end_html;

	}

	dbmclose(%URLS);

} else {

	print header,
		start_html('oops'),
		h1('Say what?'),
		hr,
		"I\'m sorry, I didn't understand that request.
		Try <a href=\"http://blank.org/link/\">again?</a>",
		end_html;

}

# cleanup and exit

exit 0;