kwotes/kwotes-lib.pl

#!/usr/bin/perl

# bring in configuration
require "kwotes.conf.pl";

# add a module directory
use lib qw(./deps);

# we use DBI, for it's sexy body
use DBI;
use GD::SecurityImage;

# super strict
package Lib;
use strict;

# template variables
$Lib::HEADER					= "header";
$Lib::FOOTER					= "footer";
$Lib::CONTENT_DEFAULT			= "default-content";
$Lib::CONTENT_ADD				= "add-kwote";
$Lib::CONTENT_ADD_THANKS		= "add-kwote-thanks";
$Lib::CONTENT_SEARCH			= "search";
$Lib::BEFORE_LIST				= "before-list";
$Lib::AFTER_LIST				= "after-list";
$Lib::NAVIGATION				= "navigation";
$Lib::NAVIGATION_NO_BACK		= "navigation-no-back";
$Lib::NAVIGATION_NO_FORWARD		= "navigation-no-forward";
$Lib::KWOTE_ODD					= "kwote-odd";
$Lib::KWOTE_EVEN				= "kwote-even";
$Lib::CONTENT_ERROR				= "error";
$Lib::HTTP_HEADERS				= "http-headers";

# database connection
$Lib::GLOBAL_DBH = undef;

# captcha stuff
$Lib::CAPTCHA_CHARS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789";
$Lib::CAPTCHA_LEN = 8;
@Lib::CAPTCHA_BG_COLORS;
push(@Lib::CAPTCHA_BG_COLORS, "\#eeceff");
push(@Lib::CAPTCHA_BG_COLORS, "\#eeee00");
push(@Lib::CAPTCHA_BG_COLORS, "\#00ff00");
@Lib::CAPTCHA_FG_COLORS;
push(@Lib::CAPTCHA_FG_COLORS, "\#000000");
push(@Lib::CAPTCHA_FG_COLORS, "\#ff0000");
push(@Lib::CAPTCHA_FG_COLORS, "\#0000ff");

##
# validates a captcha
sub validate_captcha {
	my ($cid, $phrase) = @_;

	# connect
	my $dbh = get_db_connection();
	
	# prepare and execute
	my $sth = $dbh->prepare(
		"SELECT count(*) as count FROM captchas WHERE id=? and LOWER(phrase)=LOWER(?);");
	$sth->bind_param(1, $cid);
	$sth->bind_param(2, $phrase);
	$sth->execute();
	  
	# get count
	my $row = $sth->fetchrow_hashref();
	my $count = $row->{"count"};
	
	# return
	return ($count>0);
	
}

##
# serves a captcha image
sub serve_captcha {
	my ($cid) = @_;

	# connect
	my $dbh = get_db_connection();
	
	# execute
	my $sth = $dbh->prepare("SELECT phrase FROM captchas WHERE id=?");
	$sth->bind_param(1, $cid);
	$sth->execute();

	# get row
	my $row = $sth->fetchrow_hashref();
	my $phrase = $row->{"phrase"} ? $row->{"phrase"} : "!ERROR!";
	
	# generate captcha
	my ($image_data, $mime_type) = gen_captcha($phrase);

	# send to browser
	print "Content-Type: $mime_type\n\n";
	print $image_data;
	
}

##
# returns a captcha image and other info
sub gen_captcha {
	my ($phrase) = @_;
	my $bg = $Lib::CAPTCHA_BG_COLORS[rand()*int(@Lib::CAPTCHA_BG_COLORS)];
	my $image = GD::SecurityImage->new(
		width		=> 120,
		height		=> 30,
		lines		=> (rand()*3)+1,
		gd_font		=> 'giant',
		send_ctobg	=> 0,
		bgcolor		=> $bg
	);
	$image->random($phrase);
	$image->create(
		"normalf", 
		"default", 
		$Lib::CAPTCHA_FG_COLORS[rand()*int(@Lib::CAPTCHA_FG_COLORS)]
	);
	my ($image_data, $mime_type, $random_number) = $image->out(force => 'jpeg');
	return ($image_data, $mime_type);
}

##
# generates a random captcha phrase
sub gen_captcha_phrase {
	my $phrase;
	for (my $i=0; $i<$Lib::CAPTCHA_LEN; $i++) {
		$phrase .= substr(
			$Lib::CAPTCHA_CHARS, 
			rand()*length($Lib::CAPTCHA_CHARS),
			1
		);
	}

	# get connection 
	my $dbh = get_db_connection();

    # prepare statement
    my $sth = $dbh->prepare(
    	"INSERT INTO captchas (phrase) VALUES (?)",
    ) or return undef;
                            
	# bind params
	$sth->bind_param(1, $phrase);
	
	# execute
	$sth->execute() or return undef;

	# return id
	return ($dbh->{'mysql_insertid'}) ?
		 $dbh->{'mysql_insertid'} : $sth->insert_id;

}

##
# Returns a random tagline
sub get_tagline {
	return $Conf::TAG_LINES[ @Conf::TAG_LINES*rand() ];
}

##
# Returns the kwote count
sub get_kwote_count {
	
	# connect
	my $dbh = get_db_connection();
	
	# execute
	my $sth = $dbh->prepare("SELECT COUNT(*) as kwote_count FROM kwote");
	$sth->execute();

	# return
	my $row = $sth->fetchrow_hashref();
	return $row->{"kwote_count"};
}

##
# Returns the kwote_backup count
sub get_kwote_backup_count {
	
	# connect
	my $dbh = get_db_connection();
	
	# execute
	my $sth = $dbh->prepare("SELECT COUNT(*) as kwote_count FROM kwote_backup");
	$sth->execute();

	# return
	my $row = $sth->fetchrow_hashref();
	return $row->{"kwote_count"};
}

##
# does some minor database cleanup
sub cleanup {
	
	# get a db connection
	my $dbh = get_db_connection();
	
	# backup kwotes to be deleted
	my $sth = $dbh->prepare(
		"INSERT INTO kwote_backup SELECT * FROM kwote WHERE ".
		"(now()-submit_dt)>? AND rating<=?"
	);
	$sth->bind_param(1, $Conf::KWOTE_TTL);
	$sth->bind_param(2, $Conf::KWOTE_DEATH_RATING);
	$sth->execute() or die "Couldn't backup kwotes";

	# delete kwotes
	$sth = $dbh->prepare(
		"DELETE FROM kwote WHERE (now()-submit_dt)>? AND rating<=?"
	);
	$sth->bind_param(1, $Conf::KWOTE_TTL);
	$sth->bind_param(2, $Conf::KWOTE_DEATH_RATING);
	$sth->execute() or die "Couldn't delete kwotes";

	# let em know we're good 
	print "Kwote Database cleanup complete\n";
	
	# w00t
	return 0;
}

##
# votes on a kwote
sub  vote {
	my ($addr, $kid, $amt) = @_;
	
	# connect to db
	my $dbh = get_db_connection();
	
	# prepare statement
	my $sth = $dbh->prepare(
		"SELECT COUNT(*) as vote_count FROM vote WHERE ".
		"ip_address=? AND kwote_id=? AND (now()-vote_dt)<=?"
	);
	$sth->bind_param(1, $addr);
	$sth->bind_param(2, $kid);
	$sth->bind_param(3, $Conf::SECS_BETWEEN_VOTES);
	
	# execute
	$sth->execute();
	
	# get row
	my $row = $sth->fetchrow_hashref();
	
	# check if they suck
	return undef if ($row->{"vote_count"}>=$Conf::MAX_VOTES_PER_IP);
	
	# prepare
	$sth = $dbh->prepare(
		"UPDATE kwote SET rating=rating+(?) WHERE id=?"
	);
	$sth->bind_param(1, $amt);
	$sth->bind_param(2, $kid);
	$sth->execute() or return undef;
	
	# record the vote
	$sth = $dbh->prepare(
		"INSERT INTO vote (ip_address, kwote_id, vote, vote_dt) ".
		"VALUES (?, ?, ?, now())"
	);
	$sth->bind_param(1, $addr);
	$sth->bind_param(2, $kid);
	$sth->bind_param(3, $amt);
	$sth->execute() or return undef;
	
	# we're good
	return 1;
}

##
# adds a kwote to the database
sub add_kwote {
	my ($dbh, $kwote_text, $ip_address) = @_;
	my ($addr, $kid, $amt) = @_;    

	# make sure the kwote is ok
	return undef if (!defined($kwote_text) || $kwote_text eq "");
	
	# prepare statement
	my $sth = $dbh->prepare(
		"SELECT COUNT(*) as kwote_count FROM kwote WHERE ip_address=? AND (now()-submit_dt)<?"
	);
	$sth->bind_param(1, $ip_address);
	$sth->bind_param(2, $Conf::SECS_BETWEEN_KWOTES);
	
	# execute
	$sth->execute() or return undef;
	
	# get row
	my $row = $sth->fetchrow_hashref() or return undef;
	
	# check if they suck
	return undef if ($row->{"kwote_count"}>=$Conf::MAX_KWOTES_PER_IP);
	
	# prepare statement
	my $sth = $dbh->prepare(
		"INSERT INTO kwote (submit_dt, content, rating, ip_address) ".
		"VALUES (now(), ?, ?, ?)"
	) or return undef;
		
	# bind params
	$sth->bind_param(1, $kwote_text);	# this is the kwote text
	$sth->bind_param(2, 0);				# no rating as of yet
	$sth->bind_param(3, $ip_address);	# the ip address
	
	# execute
	$sth->execute() or return undef;

	# get the id
	my $insert_id = ($dbh->{'mysql_insertid'}) ? 
		$dbh->{'mysql_insertid'} : $sth->insert_id;

	# return the id
	return $insert_id;
}

##
# adds a kwote to the database
sub get_kwote {
	my ($dbh, $kid) = @_;
	
	# prepare statement
	my $sth = $dbh->prepare(
		"SELECT * FROM kwote WHERE id=?"
	) or return undef;
		
	# bind params
	$sth->bind_param(1, $kid);
	
	# execute
	$sth->execute() or return undef;
	
	# get the row
	my $row = $sth->fetchrow_hashref();

	# return the id
	return (defined($row)) ? $row : undef;
}

##
# Gets a list of kwotes
sub list_kwotes {
	my ($dbh, $sort_by, $order_direction, $return_amt, 
	$start_index, $search_string, $min_rating, $max_rating) = @_;

	# clean up the numbers
	$return_amt =~ s/[^0-9]//ig;
	$start_index =~ s/[^0-9]//ig;

	# ensure these numbers are ok
	if ($start_index eq "" || int($start_index)<=0) {
		$start_index = 0;
	}
	if ($return_amt eq "" || int($return_amt)<=0
		|| int($return_amt) > 200) {
		$return_amt = 20;
	}

	# break out the keywords
	my @kws = split(/,/,$search_string);

	# build SQL query
	my $sql = "SELECT * FROM kwote WHERE 1=1 ";

	
	# search stuff
	if (defined($search_string)) {
		foreach my $kw (@kws) {
			$sql.= "AND content LIKE ? ";
		}
	}
	
	# min rating
	if (defined($min_rating)) {
		$sql .= "AND rating >= ? ";
	}

	# max rating
	if (defined($max_rating)) {
		$sql .= "AND rating <= ? ";
	}

	# sorting and paging
	if (defined($sort_by)) {
		$sql .=  "ORDER BY $sort_by $order_direction ";
	}
	
	# paging
	$sql .= "LIMIT $start_index, $return_amt ";

	# prepare
	my $sth = $dbh->prepare($sql) or return undef;	
	my $param_num = 1;	

	# apply the search criteria
	if (defined($search_string)) {
		for (my $i=0; $i<@kws; $i++) {
			$sth->bind_param($param_num, "\%".$kws[$i]."\%");
			$param_num++;
		}
	}

	# min rating
	if (defined($min_rating)) {
		$sth->bind_param($param_num, $min_rating);
		$param_num++;
	}

	# max rating
	if (defined($max_rating)) {
		$sth->bind_param($param_num, $max_rating);
		$param_num++;
	}

	# execute
	$sth->execute() or return undef;

	# get the rows
	my @rows;
	while (my $row = $sth->fetchrow_hashref()) {
		push(@rows, $row);
	}
	
	# return it
	return @rows;
}

##
# Connect to the database
sub get_db_connection {
	if (!$Lib::GLOBAL_DBH) {
		$Lib::GLOBAL_DBH = DBI->connect(
			"dbi:".$Conf::DB_TYPE.":".$Conf::DB_NAME.":".$Conf::DB_HOST,
			$Conf::DB_USER,
			$Conf::DB_PASS
		);
	}
	return $Lib::GLOBAL_DBH;
}

##
# Escape html
sub html_escape {
	my ($data) = @_;
	my $ret_data = "";
	foreach my $line (split(/\n/,$data)) {
		$line =~ s/</&lt;/g;
		$line =~ s/>/&gt;/g;
		$line =~ s/"/&quot;/g;
		$line =~ s/^\s+/"&nbsp;"x$+[0]/e;
		$ret_data .= "$line<br />";
	}
	return $ret_data;
}

##
# Escape xml
sub xml_escape {
	my ($data) = @_;
	my $ret_data = "";
	foreach my $line (split(/\n/,$data)) {
		$line =~ s/</&lt;/g;
		$line =~ s/>/&gt;/g;
		$line =~ s/"/&quot;/g;
		$line =~ s/^\s+/"&nbsp;"x$+[0]/e;
		$ret_data .= $line;
	}
	return $ret_data;
}

##
# Returns the appropriate http headers based
# on the template
sub get_template_headers {
	my ($template) = @_;
	open(IN, "templates/$template/$Lib::HTTP_HEADERS");
	my $data = join("",<IN>);
	close(IN);
	return $data;

}

##
# Wraps an HTML template
sub wrap_template {
	my ($template, $template_file, %vars) = @_;
	open(IN,"templates/$template/$template_file");
	my $data = join("",<IN>);
	close(IN);
	foreach my $key (keys %vars) {
		$data =~ s/\${$key}/$vars{$key}/ig;
	}
	return $data;
}

##
# Wraps and renders a template
sub render_template {
	my ($template, $template_file, %vars) = @_;
	my $data = wrap_template($template, $template_file, %vars);
	print STDOUT $data;
}

##
# Parse form data
sub parse_form {
	my (@pairs, $pair, $buffer, %FORM, $name, $value);
	if ($ENV{'REQUEST_METHOD'} eq 'GET') {
		@pairs = split(/&/, $ENV{'QUERY_STRING'});
	} elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
		@pairs = split(/&/, $buffer);
	}
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$name =~ tr/+/ /;
		$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$FORM{$name} = $value if (length($value)>0);
	}
	return %FORM;
}
                                                                                            
1;