#!/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 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; $Lib::CAPTCHA_LEN = 6; @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"}; # delete it $sth = $dbh->prepare("DELETE FROM captchas WHERE id=?"); $sth->bind_param(1, $cid); $sth->execute(); # 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 => 160, height => 40, lines => (rand()*5)+1, send_ctobg => 0, bgcolor => $bg, font => "./deps/GD/SecurityImage/StayPuft.ttf" ); $image->random($phrase); $image->create( "ttf", "circle", $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)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//>/g; $line =~ s/"/"/g; $line =~ s/^\s+/" "x$+[0]/e; $ret_data .= "$line
"; } return $ret_data; } ## # Escape xml sub xml_escape { my ($data) = @_; my $ret_data = ""; foreach my $line (split(/\n/,$data)) { $line =~ s//>/g; $line =~ s/"/"/g; $line =~ s/^\s+/" "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("",); 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("",); 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;