#!/usr/bin/perl

# Author: Kevin P. Inscoe <kevin@inscoe.org>.
# File: url_index.pl
# Date of creation: December 14, 2004
# Version: 1.0
# Warranty: None expressed or implied.
# License: The Open Software License. V1.1 http://www.opensource.org/licenses/osl.php
#
# OSI Certified Open Source Software. http://www.opensource.org/licenses/
#
# Prerequisites: Perl 5.004 (minimum).

require 5.004;

# The purpose of this program is 
#
# Display form for generating a new URI which is likely shorter than the original
# but also for tracking purposes. The browser, address and date are also collected.
# Calls submit.cgi to convert the URI and store it in the database. Subsequent
# queries update the usage counter and create enteries in another table showing
# accessors address, time and date.
#
# Change history:
#
# 0.9.0 - 12/14/04 - Create original
# 1.0.0 - 01/20/05 - Release working version
#

#Turn off Perl buffering 
$| = 1; 

# Pragmas
use strict;
use diagnostics;
use CGI;
use Mail::Sendmail;
use DBI;
use DBD::mysql;
use Date::Manip;

# Locals
my $http_host = $ENV{'HTTP_HOST'};
my $redir = $ENV{'REDIRECT_STATUS'};
my $request_uri = $ENV{'REQUEST_URI'};
my $query_string;
my $dsn = 'DBI:mysql:xxxxx:localhost';
my $db_user_name = 'xxxx';
my $db_password = 'xxxxxxxxxxxxxxxx';

# Print the Context-type so output gets dumped to the browser
print "Content-type\: text/html\n\n";

# Display the headers
&head;

my $debug = 0;

# Print all the HTTP ENV variables
if ( $debug ) {
	use CGI::Carp qw(fatalsToBrowser);	# Only when debugging
	foreach my $key (sort(keys(%ENV))) {
  	print "$key = $ENV{$key}<br>\n";
	}
}

# Display the form no matter what
&disp_page;

# Get URL if any
my $request_method = $ENV{'REQUEST_METHOD'};
if ($request_method eq "GET") { 
	$query_string = $ENV{'QUERY_STRING'};
} 
else { 
	&trail;
	exit;
}

if ($query_string eq '') { 
	&trail;
	exit;
}

&disp_result($query_string,$dsn,$db_user_name,$db_password);

&trail;

exit;

sub disp_page {

	print "<form action=\042/submit.cgi\042 method=\042post\042>\n";
	print "<input size=\04280\042 name=\042url\042 /><br />\n";
	print "<p><input type=\042submit\042 value=\042Generate alternate URI\042 /><p><p>\n";
}

sub disp_result {

my ($uri,$dsn,$db_user_name,$db_password) = @_;

# Locals
my $refer = $ENV{'HTTP_REFERER'};
my $browser = $ENV{'HTTP_USER_AGENT'};
my $ip = $ENV{'REMOTE_ADDR'};

# Open a connection to the database
my $dbh = DBI->connect($dsn, $db_user_name, $db_password)
    or &send_error("Couldn't connect to database: $DBI::errstr","disp_result");

my $sql = "SELECT url,visits,created,visits FROM uri WHERE uri = '$uri';";

my $statement = $dbh->prepare($sql)
    or &send_error("Couldn't prepare query '$sql': $DBI::errstr","disp_result");

$statement->execute()
    or &send_error("Couldn't execute query '$sql': $DBI::errstr","disp_result");

my $row = $statement->fetchrow_hashref();

if ($row) {
	my $result = $row->{url};
	my $visits = $row->{visits};
	my $created = $row->{created};
	my $numvisits = $row->{visits};

# Update the record

# Increment the vists count
	$visits++;

# Get the full date stamp for last_updated
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
	my $last = sprintf "%4d%02d%02d%02d%02d%02d\n",$year+1900,$mon+1,$mday,$hour,$min,$sec;

	$sql = "UPDATE uri SET last_visit='$last',visits='$visits' WHERE uri='$uri';";
	$statement = $dbh->prepare($sql)
        	or &send_error("Couldn't prepare query '$sql': $DBI::errstr","disp_result");
	$statement->execute()
        	or &send_error("Couldn't execute query '$sql': $DBI::errstr","disp_result");

# Translate the RFC 1738 encoding to HTML friendly format...
# New a better way to do this... maybe a subroutine to parse each % field.
	$result =~ s/%3A/:/g;
	$result =~ s/%2F/\//g;
	$result =~ s/%3F/\?/g;
	$result =~ s/%3D/\=/g;
	$result =~ s/%26/\&/g;
	$result =~ s/%2C/\,/g;

# Calculate the age of the last uri
	my $datediff = &calc_dates($created);

	print "Your URL is <br><br><b><a href=\042$result\042>$result</a></b><p>\n";
	print "<p>Created $datediff ago.<p>\n";
	print "<p>$numvisits visits.<p>\n";

# Create the hit record
# uri, ip, browser, time. referrer

	$sql = "INSERT INTO hits (uri,ip,browser,referer,time) VALUES ('$uri','$ip','$browser','$refer', '$last');";
	$statement = $dbh->prepare($sql)
        	or &send_error("Couldn't prepare query '$sql': $DBI::errstr","disp_result");
	$statement->execute()
        	or &send_error("Couldn't execute query '$sql': $DBI::errstr","disp_result");

}
else {
	print "<b>Sorry that URL is not in our database. Please try again.</b><p>\n";
}

# Close db
$statement->finish();
$dbh->disconnect();

}

sub send_error {

my ($error, $routine)=@_;

print "<p>An internal error has occured. The Web administrator has been notified.<br>\n";
print "Please try again. If the error persists please try again later.<br>\n";
print "<br>Sorry for the inconvenience.<p>\n";

my %mail =      ( To    => 'admin@kevininscoe.com',
                From    => 'admin@kevininscoe.com',
                Subject => 'Error from url.kevininscoe.com',
                Message => "Error from url.kevininscoe.com/index.cgi in routine $routine:\n\n$error\n\n"
                );

sendmail(%mail) or die $Mail::Sendmail::error;

exit 1;

}

sub head {

print "<html><head><title>url.kevininscoe.com - Kevin's URI service</title></head>\n";
print "<body><center><h3>Kevin's URI Service</h3><p>\n";

}

sub trail {

print "You can also visit: The <a href=\042http://url.kevininscoe.com/ranking.cgi?most\042>most</a> visited URL, the <a href=\042http://url.kevininscoe.com/ranking.cgi?longest\042>longest</a> URL and the <a href=\042http://url.kevininscoe.com/ranking.cgi?shortest\042>shortest</a> URL in our database.<p><p>\n";
print "<a href=\042http://url.kevininscoe.com/terms\042>Terms of Service</a><p>\n";
print "</form><br><br>\n";
print "<i>Copyright &copy; 2005 Kevin P. Inscoe</i>\n";
print "</body></html>\n";

$!;

}

sub calc_dates {

my ($created) = @_;

# Locals
my ($datediff,$cyear,$cmonth,$cday,$cdays,$chour,$cmin,$now,$days);

# Get the full date stamp
my ($sec,$min,$hour,$mday,$mon,$yr,$wday,$yday,$isdst)=localtime(time);
my $year = sprintf "%4d",$yr+1900;
my $month = sprintf "%02d",$mon+1;

# Convert the created time into epoch time
$cyear = substr($created,0,4);
$cmonth = substr($created,4,2);
$cday = substr($created,6,2);
$chour = substr($created,8,2);
$cmin = substr($created,10,2);

#print "<p>cyear=$cyear, cmonth=$cmonth, cday=$cday, chour=$chour, cmin=$cmin<p><p>\n";

# If less than a day difference have to use the time fields
# http://search.cpan.org/~sbeck/DateManip-5.40/Manip.pod
my $ctime = &ParseDate("$cmonth/$cday/$cyear $chour:$cmin");
my $ntime = &ParseDate("$month/$mday/$year $hour:$min");
my $delta = &DateCalc($ntime,$ctime);
# => 0:0:WK:DD:HH:MM:SS   the weeks, days, hours, minutes, and seconds between the two
my ($dummy1,$dummy2,$dwks,$ddays,$dhours,$dmins,$dsecs) = split (/:/,$delta);

#print "<p>delta=$delta mins=$dmins, hours=$dhours<p><p>\n";

#print "<p>dwks=$dwks, ddays=$ddays, dhours=$dhours, dmins=$dmins, dsecs=$dsecs<p><p>\n";

# Decide how to format it
$datediff = "";
if ($ddays > 0) { $datediff = "$ddays day(s)"; }
else { if ($dhours > 0) { $datediff = "$dhours hour(s)" }
        else { $datediff = "$dmins minute(s)" }
}

return ($datediff);

}