#!/usr/bin/perl # Author: Kevin P. Inscoe . # File: url_ranking.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; use Switch; # 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:xxxxxx:localhost'; my $db_user_name = 'xxxxxxx'; my $db_password = 'xxxxxxxxxx'; # 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}
\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'}; #print "

query_string=$query_string

\n"; } 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 "

\n"; print "
\n"; print "

\n"; } sub disp_result { my ($query_string,$dsn,$db_user_name,$db_password) = @_; # Locals my $refer = $ENV{'HTTP_REFERER'}; my $browser = $ENV{'HTTP_USER_AGENT'}; my $ip = $ENV{'REMOTE_ADDR'}; my ($uri,$result,$visits,$created,); # 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 * FROM ranking WHERE keyid = '1';"; 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 $uri_longest = $row->{uri_longest}; my $uri_shortest = $row->{uri_shortest}; my $uri_most_visited = $row->{uri_most_visited}; switch ($query_string) { case "most" { $uri = $uri_most_visited; } case "longest" { $uri = $uri_longest; } case "shortest" { $uri = $uri_shortest; } } # Pull up the uri my $sql = "SELECT url,visits,created 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"); $row = $statement->fetchrow_hashref(); if ($row) { $result = $row->{url}; $visits = $row->{visits}; $created = $row->{created}; } # Calculate the age of the last uri my $datediff = &calc_dates($created); switch ($query_string) { case "most" { print "The most often accessed URL in the system is\n"; } case "longest" { print "The longest URL in the system is\n"; } case "shortest" { print "The shortest URL in the system is\n"; } } print "

$result

\n"; print "Linkable URI is

http://url.kevininscoe.com/?$uri

\n"; print "

Created $datediff ago.

\n"; print "

$visits visits.

\n"; } # Close db $statement->finish(); $dbh->disconnect(); } sub send_error { my ($error, $routine)=@_; print "

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

\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 "url.kevininscoe.com - Kevin's URI service\n"; print "

Kevin's URI Service

\n"; } sub trail { print "You can also visit: The most visited URL, the longest URL and the shortest URL in our database.

\n"; print "Terms of Service

\n"; print "



\n"; print "Copyright © 2005 Kevin P. Inscoe\n"; print "\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 "

month=$month year=$year day=$mday hour=$hour min=$min

\n"; #print "

created=$created cyear=$cyear, cmonth=$cmonth, cday=$cday, chour=$chour, cmin=$cmin

\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 "

ctime=$ctime ntime=$ntime

\n"; #print "

delta=$delta mins=$dmins, hours=$dhours

\n"; #print "

dwks=$dwks, ddays=$ddays, dhours=$dhours, dmins=$dmins, dsecs=$dsecs

\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); }