| 1 |
|
|---|
| 2 |
# Blogsum |
|---|
| 3 |
# Copyright (c) 2009 Jason Dixon <jason@dixongroup.net> |
|---|
| 4 |
# All rights reserved. |
|---|
| 5 |
|
|---|
| 6 |
|
|---|
| 7 |
########################### |
|---|
| 8 |
# pragmas and vars # |
|---|
| 9 |
########################### |
|---|
| 10 |
use strict; |
|---|
| 11 |
use Blogsum::Config; |
|---|
| 12 |
my $database = $Blogsum::Config::database; |
|---|
| 13 |
my $tmplfile_index = $Blogsum::Config::tmplfile_index; |
|---|
| 14 |
my $blog_theme = $Blogsum::Config::blog_theme; |
|---|
| 15 |
my $blog_title = $Blogsum::Config::blog_title; |
|---|
| 16 |
my $blog_subtitle = $Blogsum::Config::blog_subtitle; |
|---|
| 17 |
my $blog_url = $Blogsum::Config::blog_url; |
|---|
| 18 |
my $blog_owner = $Blogsum::Config::blog_owner; |
|---|
| 19 |
my $blog_rights = $Blogsum::Config::blog_rights; |
|---|
| 20 |
my $feed_updates = $Blogsum::Config::feed_updates; |
|---|
| 21 |
my $captcha_pubkey = $Blogsum::Config::captcha_pubkey; |
|---|
| 22 |
my $captcha_seckey = $Blogsum::Config::captcha_seckey; |
|---|
| 23 |
my $comment_max_length = $Blogsum::Config::comment_max_length; |
|---|
| 24 |
my $comments_allowed = $Blogsum::Config::comments_allowed; |
|---|
| 25 |
my $smtp_server = $Blogsum::Config::smtp_server; |
|---|
| 26 |
my $smtp_sender = $Blogsum::Config::smtp_sender; |
|---|
| 27 |
my $articles_per_page = $Blogsum::Config::articles_per_page; |
|---|
| 28 |
my $google_analytics_id = $Blogsum::Config::google_analytics_id; |
|---|
| 29 |
my $google_webmaster_id = $Blogsum::Config::google_webmaster_id; |
|---|
| 30 |
|
|---|
| 31 |
|
|---|
| 32 |
########################### |
|---|
| 33 |
# main execution # |
|---|
| 34 |
########################### |
|---|
| 35 |
my $cgi = CGI->new; |
|---|
| 36 |
my $dbh = DBI->connect("DBI:SQLite:dbname=$database", '', '', { RaiseError => 1 }) || die $DBI::errstr; |
|---|
| 37 |
my $template = HTML::Template->new(filename => $tmplfile_index, die_on_bad_params => 0); |
|---|
| 38 |
if ($cgi->param('rss')) { |
|---|
| 39 |
output_rss(); |
|---|
| 40 |
} else { |
|---|
| 41 |
read_comment() if $comments_allowed; |
|---|
| 42 |
my $articles = get_articles(); |
|---|
| 43 |
my $archives = get_archives(); |
|---|
| 44 |
$template->param( archives => $archives ); |
|---|
| 45 |
$template->param( theme => $blog_theme ); |
|---|
| 46 |
$template->param( title => $blog_title ); |
|---|
| 47 |
$template->param( subtitle => $blog_subtitle ); |
|---|
| 48 |
$template->param( copyright => $blog_rights ); |
|---|
| 49 |
$template->param( google_analytics_id => $google_analytics_id ); |
|---|
| 50 |
$template->param( google_webmaster_id => $google_webmaster_id ); |
|---|
| 51 |
if (@{$articles}) { |
|---|
| 52 |
$template->param( articles => $articles ); |
|---|
| 53 |
if ($cgi->param('uri') && $comments_allowed) { |
|---|
| 54 |
$template->param( comment_form => 1 ); |
|---|
| 55 |
$template->param( comment_max_length => $comment_max_length ); |
|---|
| 56 |
$template->param( id => $articles->[0]->{'id'} ); |
|---|
| 57 |
} |
|---|
| 58 |
} else { |
|---|
| 59 |
$template->param( error => '404 post not found' ); |
|---|
| 60 |
} |
|---|
| 61 |
print $cgi->header(), $template->output; |
|---|
| 62 |
} |
|---|
| 63 |
$dbh->disconnect; |
|---|
| 64 |
|
|---|
| 65 |
|
|---|
| 66 |
########################### |
|---|
| 67 |
# subfunctions # |
|---|
| 68 |
########################### |
|---|
| 69 |
|
|---|
| 70 |
sub output_rss { |
|---|
| 71 |
|
|---|
| 72 |
my $version = ($cgi->param('rss') == 2) ? '2.0' : '1.0'; |
|---|
| 73 |
my $rss = XML::RSS->new( version => $version ); |
|---|
| 74 |
|
|---|
| 75 |
$rss->channel ( |
|---|
| 76 |
title => $blog_title, |
|---|
| 77 |
link => $blog_url, |
|---|
| 78 |
description => $blog_subtitle, |
|---|
| 79 |
dc => { |
|---|
| 80 |
subject => $blog_title, |
|---|
| 81 |
creator => $blog_owner, |
|---|
| 82 |
publisher => $blog_owner, |
|---|
| 83 |
rights => $blog_rights, |
|---|
| 84 |
language => 'en-us', |
|---|
| 85 |
}, |
|---|
| 86 |
syn => { |
|---|
| 87 |
updatePeriod => $feed_updates, |
|---|
| 88 |
updateFrequency => 1, |
|---|
| 89 |
updateBase => '1901-01-01T00:00+00:00', |
|---|
| 90 |
} |
|---|
| 91 |
); |
|---|
| 92 |
|
|---|
| 93 |
my $articles = get_articles(); |
|---|
| 94 |
for my $item (@{$articles}) { |
|---|
| 95 |
$item->{'date'} =~ /(\d{4})\-(\d{2})\-\d{2} \d{2}\:\d{2}\:\d{2}/; |
|---|
| 96 |
($item->{'year'}, $item->{'month'}) = ($1, $2); |
|---|
| 97 |
my $link = sprintf("%s%s/%s/%s", $blog_url, $item->{'year'}, $item->{'month'}, $item->{'uri'}); |
|---|
| 98 |
|
|---|
| 99 |
if ($version eq '2.0') { |
|---|
| 100 |
$rss->add_item ( |
|---|
| 101 |
title => $item->{'title'}, |
|---|
| 102 |
link => $link, |
|---|
| 103 |
description => $item->{'body'}, |
|---|
| 104 |
author => $item->{'author'}, |
|---|
| 105 |
category => [split(/,/, $item->{'tags'})], |
|---|
| 106 |
comments => $link . '#comments', |
|---|
| 107 |
pubDate => POSIX::strftime("%a, %d %b %Y %H:%M:%S %Z", gmtime($item->{'epoch'})), |
|---|
| 108 |
); |
|---|
| 109 |
} else { |
|---|
| 110 |
$rss->add_item ( |
|---|
| 111 |
title => $item->{'title'}, |
|---|
| 112 |
link => $link, |
|---|
| 113 |
description => $item->{'body'}, |
|---|
| 114 |
dc => { |
|---|
| 115 |
subject => $blog_title, |
|---|
| 116 |
creator => $item->{'author'}, |
|---|
| 117 |
date => POSIX::strftime("%a, %d %b %Y %H:%M:%S %Z", gmtime($item->{'epoch'})), |
|---|
| 118 |
}, |
|---|
| 119 |
); |
|---|
| 120 |
} |
|---|
| 121 |
} |
|---|
| 122 |
print $cgi->header('application/rss+xml'), $rss->as_string; |
|---|
| 123 |
} |
|---|
| 124 |
|
|---|
| 125 |
sub get_articles { |
|---|
| 126 |
|
|---|
| 127 |
my $page; |
|---|
| 128 |
my $offset; |
|---|
| 129 |
my $limit_clause; |
|---|
| 130 |
my $where_clause; |
|---|
| 131 |
my $j = 0; |
|---|
| 132 |
my $show_comments = 0; |
|---|
| 133 |
|
|---|
| 134 |
$articles_per_page = ($articles_per_page > 0) ? $articles_per_page : -1; |
|---|
| 135 |
if ($cgi->param('page') && POSIX::isdigit($cgi->param('page'))) { |
|---|
| 136 |
$page = $cgi->param('page'); |
|---|
| 137 |
$offset = ($page - 1) * $articles_per_page; |
|---|
| 138 |
} else { |
|---|
| 139 |
$page = 1; |
|---|
| 140 |
$offset = 0; |
|---|
| 141 |
} |
|---|
| 142 |
$limit_clause = " LIMIT $articles_per_page OFFSET $offset"; |
|---|
| 143 |
|
|---|
| 144 |
if (($cgi->param('year') =~ /\d{4}/)&& (1900 < $cgi->param('year')) && ($cgi->param('year') < 2036)) { |
|---|
| 145 |
$where_clause .= 'WHERE date LIKE \'%' . $cgi->param('year'); |
|---|
| 146 |
$j++; |
|---|
| 147 |
if (($cgi->param('month') =~ /\d{2}/) && (0 < $cgi->param('month')) && ($cgi->param('month') < 12)) { |
|---|
| 148 |
$where_clause .= '-' . $cgi->param('month') . '%\' AND enabled=1 '; |
|---|
| 149 |
$j++; |
|---|
| 150 |
if ($cgi->param('uri') =~ /\w+/) { |
|---|
| 151 |
$where_clause .= 'AND uri=? AND enabled=1 '; |
|---|
| 152 |
$limit_clause = ''; |
|---|
| 153 |
$j++; |
|---|
| 154 |
$show_comments=1; |
|---|
| 155 |
} |
|---|
| 156 |
} else { |
|---|
| 157 |
$where_clause .= "\%' AND enabled=1 "; |
|---|
| 158 |
} |
|---|
| 159 |
} elsif ($cgi->param('search')) { |
|---|
| 160 |
$where_clause .= "WHERE (tags LIKE ? OR author LIKE ?) AND enabled=1 "; |
|---|
| 161 |
|
|---|
| 162 |
} elsif ($cgi->param('id')) { |
|---|
| 163 |
$where_clause .= 'WHERE id=? AND enabled=1 '; |
|---|
| 164 |
$limit_clause = ''; |
|---|
| 165 |
$show_comments=1; |
|---|
| 166 |
|
|---|
| 167 |
} else { |
|---|
| 168 |
$where_clause .= 'WHERE enabled=1 '; |
|---|
| 169 |
} |
|---|
| 170 |
|
|---|
| 171 |
my $query = 'SELECT *, strftime("%s", date) AS epoch FROM articles ' . $where_clause . 'ORDER BY date DESC' . $limit_clause; |
|---|
| 172 |
my $sth = $dbh->prepare($query); |
|---|
| 173 |
|
|---|
| 174 |
if ($j == 3) { |
|---|
| 175 |
$sth->execute($cgi->param('uri')) || die $dbh->errstr; |
|---|
| 176 |
} elsif ($cgi->param('search')) { |
|---|
| 177 |
my $search_tag = sprintf("%%%s%%", $cgi->param('search')); |
|---|
| 178 |
$sth->execute($search_tag, $search_tag) || die $dbh->errstr; |
|---|
| 179 |
} elsif ($cgi->param('id')) { |
|---|
| 180 |
$sth->execute($cgi->param('id')) || die $dbh->errstr; |
|---|
| 181 |
} else { |
|---|
| 182 |
$sth->execute() || die $dbh->errstr; |
|---|
| 183 |
} |
|---|
| 184 |
|
|---|
| 185 |
my @articles; |
|---|
| 186 |
while (my $result = $sth->fetchrow_hashref) { |
|---|
| 187 |
$result->{'date'} =~ /(\d{4})\-(\d{2})\-\d{2} \d{2}\:\d{2}\:\d{2}/; |
|---|
| 188 |
($result->{'year'}, $result->{'month'}) = ($1, $2); |
|---|
| 189 |
# cut off readmore if we're on the front page |
|---|
| 190 |
if (($result->{'body'} =~ /<!--readmore-->/) && ($j < 3) && !($cgi->param('rss'))) { |
|---|
| 191 |
$result->{'body'} =~ /(.*)\<\!\-\-readmore\-\-\>/s; |
|---|
| 192 |
$result->{'body'} = $1; |
|---|
| 193 |
$result->{'readmore'}++; |
|---|
| 194 |
} |
|---|
| 195 |
$result->{'tag_loop'} = format_tags($result->{'tags'}) if ($result->{'tags'}); |
|---|
| 196 |
my $comments = get_comments(article_id => $result->{'id'}, enabled => 1); |
|---|
| 197 |
$result->{'comments_count'} = scalar(@{$comments}); |
|---|
| 198 |
if ($show_comments) { |
|---|
| 199 |
$result->{'comments'} = $comments; |
|---|
| 200 |
} |
|---|
| 201 |
push(@articles, $result); |
|---|
| 202 |
} |
|---|
| 203 |
|
|---|
| 204 |
my $query2 = 'SELECT count(*) as total FROM articles WHERE enabled=1'; |
|---|
| 205 |
my $sth2 = $dbh->prepare($query2); |
|---|
| 206 |
$sth2->execute || die $dbh->errstr; |
|---|
| 207 |
my $article_count = $sth2->fetchrow_hashref->{'total'}; |
|---|
| 208 |
if ($j < 3) { |
|---|
| 209 |
$template->param( page_next => ($page + 1) ) if ($article_count > ($offset + $articles_per_page)); |
|---|
| 210 |
$template->param( page_last => ($page - 1) ) if (($page > 1) && ($article_count > $offset)); |
|---|
| 211 |
} |
|---|
| 212 |
|
|---|
| 213 |
return (\@articles); |
|---|
| 214 |
} |
|---|
| 215 |
|
|---|
| 216 |
sub get_archives { |
|---|
| 217 |
|
|---|
| 218 |
my %history; |
|---|
| 219 |
my @archives; |
|---|
| 220 |
my @archives_compressed; |
|---|
| 221 |
my $current_year = $cgi->param('year') || ((localtime)[5] + 1900); |
|---|
| 222 |
my %months = ( |
|---|
| 223 |
'01' => 'January', |
|---|
| 224 |
'02' => 'February', |
|---|
| 225 |
'03' => 'March', |
|---|
| 226 |
'04' => 'April', |
|---|
| 227 |
'05' => 'May', |
|---|
| 228 |
'06' => 'June', |
|---|
| 229 |
'07' => 'July', |
|---|
| 230 |
'08' => 'August', |
|---|
| 231 |
'09' => 'September', |
|---|
| 232 |
'10' => 'October', |
|---|
| 233 |
'11' => 'November', |
|---|
| 234 |
'12' => 'December', |
|---|
| 235 |
); |
|---|
| 236 |
my $current_month = $cgi->param('month') || sprintf("%0.2d", ((localtime)[4] + 1)); |
|---|
| 237 |
|
|---|
| 238 |
my $query = 'SELECT * FROM articles WHERE enabled=1 ORDER BY date DESC'; |
|---|
| 239 |
my $sth = $dbh->prepare($query); |
|---|
| 240 |
$sth->execute || die $dbh->errstr; |
|---|
| 241 |
while (my $result = $sth->fetchrow_hashref) { |
|---|
| 242 |
$result->{'date'} =~ /(\d{4})\-(\d{2})\-\d{2} \d{2}\:\d{2}\:\d{2}/; |
|---|
| 243 |
($result->{'year'}, $result->{'month'}) = ($1, $2); |
|---|
| 244 |
my $title = my $full_title = $result->{'title'}; |
|---|
| 245 |
if (length($title) > 28) { |
|---|
| 246 |
$title = substr($title, 0, 25) . '...'; |
|---|
| 247 |
} |
|---|
| 248 |
|
|---|
| 249 |
if (($result->{'year'} eq $current_year) && ($result->{'month'} eq $current_month) && $result->{'uri'}) { |
|---|
| 250 |
push(@{$history{$result->{'year'}}{$result->{'month'}}->{'uri_loop'}}, |
|---|
| 251 |
{ |
|---|
| 252 |
year => $result->{'year'}, |
|---|
| 253 |
month => $result->{'month'}, |
|---|
| 254 |
month_name => $months{$result->{'month'}}, |
|---|
| 255 |
title => $title, |
|---|
| 256 |
full_title => $full_title, |
|---|
| 257 |
uri => $result->{'uri'}, |
|---|
| 258 |
} |
|---|
| 259 |
); |
|---|
| 260 |
} else { |
|---|
| 261 |
$history{$result->{'year'}}->{$result->{'month'}}->{'count'}++; |
|---|
| 262 |
} |
|---|
| 263 |
$history{$result->{'year'}}->{'count'}++; |
|---|
| 264 |
|
|---|
| 265 |
} |
|---|
| 266 |
|
|---|
| 267 |
for my $year (sort {$b <=> $a} keys %history) { |
|---|
| 268 |
no strict "refs"; |
|---|
| 269 |
for my $month (sort {$b <=> $a} keys %{$history{$year}}) { |
|---|
| 270 |
my $m = { |
|---|
| 271 |
'year' => $year, |
|---|
| 272 |
'month' => $month, |
|---|
| 273 |
'month_name' => $months{$month}, |
|---|
| 274 |
'count' => $history{$year}->{$month}->{'count'}, |
|---|
| 275 |
}; |
|---|
| 276 |
# check to see if uri_loop exists first |
|---|
| 277 |
if ($history{$year}->{$month}->{'uri_loop'}) { |
|---|
| 278 |
$m->{'uri_loop'} = $history{$year}->{$month}->{'uri_loop'}; |
|---|
| 279 |
} |
|---|
| 280 |
push(@{$history{$year}->{'month_loop'}}, $m) unless ($month eq 'count'); |
|---|
| 281 |
} |
|---|
| 282 |
my $y = { |
|---|
| 283 |
'year' => $year, |
|---|
| 284 |
'count' => $history{$year}->{'count'}, |
|---|
| 285 |
}; |
|---|
| 286 |
# check to see if we're showing this year, and that month_loop exists |
|---|
| 287 |
if (($year eq $current_year) && $history{$year}->{'month_loop'}) { |
|---|
| 288 |
$y->{'month_loop'} = $history{$year}->{'month_loop'}; |
|---|
| 289 |
} |
|---|
| 290 |
push(@{$history{'year_loop'}}, $y) unless ($year eq 'count'); |
|---|
| 291 |
} |
|---|
| 292 |
|
|---|
| 293 |
return \@{$history{'year_loop'}}; |
|---|
| 294 |
} |
|---|
| 295 |
|
|---|
| 296 |
sub format_tags { |
|---|
| 297 |
|
|---|
| 298 |
my $tags = shift; |
|---|
| 299 |
my @tags; |
|---|
| 300 |
|
|---|
| 301 |
foreach (split(/,/, $tags)) { |
|---|
| 302 |
push(@tags, { 'tag' => $_ }); |
|---|
| 303 |
} |
|---|
| 304 |
|
|---|
| 305 |
return \@tags; |
|---|
| 306 |
} |
|---|
| 307 |
|
|---|
| 308 |
sub read_comment { |
|---|
| 309 |
|
|---|
| 310 |
my $captcha = Captcha::reCAPTCHA->new; |
|---|
| 311 |
my %friendly_errors = ( |
|---|
| 312 |
'invalid-site-public-key' => "oh noes, this shouldn't happen", |
|---|
| 313 |
'invalid-site-private-key' => "oh noes, this shouldn't happen", |
|---|
| 314 |
'invalid-request-cookie' => "oh noes, this shouldn't happen", |
|---|
| 315 |
'verify-params-incorrect' => "oh noes, this shouldn't happen", |
|---|
| 316 |
'invalid-referrer' => "oh noes, this shouldn't happen", |
|---|
| 317 |
'recaptcha-not-reachable' => "oh noes, this shouldn't happen", |
|---|
| 318 |
'incorrect-captcha-sol' => "oopsie, try again", |
|---|
| 319 |
); |
|---|
| 320 |
|
|---|
| 321 |
if ($cgi->param('recaptcha_response_field') && $cgi->param('comment') && $cgi->param('id')) { |
|---|
| 322 |
|
|---|
| 323 |
# test our captcha |
|---|
| 324 |
my $result = $captcha->check_answer( $captcha_seckey, $ENV{'REMOTE_ADDR'}, $cgi->param('recaptcha_challenge_field'), $cgi->param('recaptcha_response_field') ); |
|---|
| 325 |
|
|---|
| 326 |
if ($result->{'is_valid'}) { |
|---|
| 327 |
|
|---|
| 328 |
# save comment |
|---|
| 329 |
my $comment = HTML::Entities::encode($cgi->param('comment')); |
|---|
| 330 |
my $stmt = "INSERT INTO comments VALUES (NULL, ?, datetime('now'), ?, ?, ?, ?, 0)"; |
|---|
| 331 |
my $sth = $dbh->prepare($stmt); |
|---|
| 332 |
my $comment_name = $cgi->param('name') ? substr($cgi->param('name'), 0, 100) : 'anonymous'; |
|---|
| 333 |
my $comment_email = $cgi->param('email') ? substr($cgi->param('email'), 0, 100) : undef; |
|---|
| 334 |
my $comment_url = $cgi->param('url') ? substr($cgi->param('url'), 0, 100) : undef; |
|---|
| 335 |
my $comment_body = substr(HTML::Entities::encode($cgi->param('comment')), 0, $comment_max_length); |
|---|
| 336 |
$sth->execute($cgi->param('id'), $comment_name, $comment_email, $comment_url, $comment_body) || die $dbh->errstr; |
|---|
| 337 |
$template->param( message => 'comment awaiting moderation, thank you' ); |
|---|
| 338 |
|
|---|
| 339 |
# send email notification |
|---|
| 340 |
my $smtp = Net::SMTP->new($smtp_server); |
|---|
| 341 |
$smtp->mail($ENV{USER}); |
|---|
| 342 |
$smtp->to("$blog_owner\n"); |
|---|
| 343 |
$smtp->data(); |
|---|
| 344 |
$smtp->datasend("From: $smtp_sender\n"); |
|---|
| 345 |
$smtp->datasend("To: $blog_owner\n"); |
|---|
| 346 |
$smtp->datasend("Subject: $blog_title comment submission\n\n"); |
|---|
| 347 |
$smtp->datasend("You have received a new comment submission.\n\n"); |
|---|
| 348 |
$smtp->datasend(sprintf("From: %s\n", $comment_name)); |
|---|
| 349 |
$smtp->datasend(sprintf("Date: %s\n", scalar(localtime))); |
|---|
| 350 |
$smtp->datasend(sprintf("Comment:\n\"%s\"\n\n", $comment_body)); |
|---|
| 351 |
$smtp->datasend("Moderate comments at ${blog_url}admin.cgi?view=moderate\n"); |
|---|
| 352 |
$smtp->dataend(); |
|---|
| 353 |
$smtp->quit; |
|---|
| 354 |
} else { |
|---|
| 355 |
$template->param( error => $friendly_errors{ $result->{'error'} } ); |
|---|
| 356 |
$template->param( name => $cgi->param('name') ); |
|---|
| 357 |
$template->param( email => $cgi->param('email') ); |
|---|
| 358 |
$template->param( url => $cgi->param('url') ); |
|---|
| 359 |
$template->param( comment => $cgi->param('comment') ); |
|---|
| 360 |
$template->param( id => $cgi->param('id') ); |
|---|
| 361 |
} |
|---|
| 362 |
} |
|---|
| 363 |
# present the challenge |
|---|
| 364 |
$template->param( captcha => $captcha->get_html( $captcha_pubkey ) ); |
|---|
| 365 |
} |
|---|
| 366 |
|
|---|
| 367 |
sub get_comments { |
|---|
| 368 |
|
|---|
| 369 |
my %args = @_; |
|---|
| 370 |
|
|---|
| 371 |
my $query = 'SELECT * FROM comments WHERE article_id=? AND enabled=? ORDER BY date ASC'; |
|---|
| 372 |
my $sth = $dbh->prepare($query); |
|---|
| 373 |
$sth->execute($args{'article_id'}, $args{'enabled'}) || die $dbh->errstr; |
|---|
| 374 |
my @comments; |
|---|
| 375 |
while (my $result = $sth->fetchrow_hashref) { |
|---|
| 376 |
push(@comments, $result); |
|---|
| 377 |
} |
|---|
| 378 |
return \@comments; |
|---|
| 379 |
} |
|---|
| 380 |
|
|---|
