# Blogsum NG # # Copyright (c) 2012 Dimitri Sokolyuk # Copyright (c) 2010 DixonGroup Consulting # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # - Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # - Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE # COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN # ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # ########################### # pragmas and vars # ########################### use strict; use Blogsum::Config; my $database = $Blogsum::Config::database; my $blog_theme = $Blogsum::Config::blog_theme; my $blog_title = $Blogsum::Config::blog_title; my $blog_subtitle = $Blogsum::Config::blog_subtitle; my $blog_url = $Blogsum::Config::blog_url; $blog_url .= '/' unless ($blog_url =~ /^.*\/$/); my $blog_owner = $Blogsum::Config::blog_owner; my $blog_rights = $Blogsum::Config::blog_rights; my $captcha_api_server = $Blogsum::Config::captcha_api_server; my $captcha_pubkey = $Blogsum::Config::captcha_pubkey; my $captcha_seckey = $Blogsum::Config::captcha_seckey; my $comment_max_length = $Blogsum::Config::comment_max_length; my $comments_allowed = $Blogsum::Config::comments_allowed; my $smtp_server = $Blogsum::Config::smtp_server; my $smtp_sender = $Blogsum::Config::smtp_sender; my $articles_per_page = $Blogsum::Config::articles_per_page; my $google_analytics_id = $Blogsum::Config::google_analytics_id; my $google_webmaster_id = $Blogsum::Config::google_webmaster_id; my $max_tags_in_cloud = $Blogsum::Config::max_tags_in_cloud; my $page_not_found_error = $Blogsum::Config::page_not_found_error; $page_not_found_error ||= '404 page not found'; ########################### # main execution # ########################### my $cgi = CGI->new; my $dbh = DBI->connect("DBI:SQLite:dbname=$database", '', '', { RaiseError => 1 }) || die $DBI::errstr; my $template = HTML::Template->new(filename => "themes/${blog_theme}/index.tmpl", die_on_bad_params => 0); my $path = $cgi->path_info(); my $output = \&output_article; my @args; if ( $path =~ /^\/(\d{4})\/(\d{2})\/([^\/]+)$/ ) { @args = ( year => $1, month => $2, uri => $3 ); } elsif ( $path =~ m/^\/(\d{4})\/(\d{2})\/?$/ ) { @args = ( year => $1, month => $2 ); } elsif ( $path =~ m/^\/(\d{4})\/?$/ ) { @args = ( year => $1 ); } elsif ( $path =~ m/^\/Page\/(\d+)$/ ) { @args = ( page => $1 ); } elsif ( $path =~ m/^\/Tags\/(\w+)$/ ) { @args = ( tag => $1 ); } elsif ( $path =~ m/^\/rss\.xml$/ ) { $output = \&output_rss; } elsif ( $path =~ m/^\/sitemap\.xml$/ ) { $output = \&output_sitemap; } $cgi->charset('UTF-8'); $output->( @args ); $dbh->disconnect; ########################### # subfunctions # ########################### sub output_article { my %args = @_; my $articles = get_articles( %args ); my $archives = get_archives( %args ); my $tagcloud = get_tag_cloud(); my @status = (); read_comment() if $comments_allowed; $template->param( script_name => $cgi->script_name() ); $template->param( archives => $archives ); $template->param( tagcloud => $tagcloud ); $template->param( theme => $blog_theme ); $template->param( blog_url => $blog_url ); $template->param( title => $blog_title ); $template->param( subtitle => $blog_subtitle ); $template->param( copyright => $blog_rights ); $template->param( google_analytics_id => $google_analytics_id ); $template->param( google_webmaster_id => $google_webmaster_id ); if (@{$articles}) { $template->param( articles => $articles ); if ($comments_allowed && $args{'uri'}) { $template->param( comment_form => 1 ); $template->param( comment_max_length => $comment_max_length ); $template->param( id => $articles->[0]->{'id'} ); } } else { $template->param( error => $page_not_found_error ); @status = ( -status => '404 Not Found' ); } print $cgi->header(@status), $template->output; } sub output_rss { my $rss = XML::RSS->new( version => '2.0' ); $rss->channel ( title => $blog_title, link => $blog_url, description => $blog_subtitle, managingEditor => $blog_owner, webMaster => $blog_owner, copyright => $blog_rights, language => 'en', ); my $articles = get_articles( more => 1 ); for my $item (@{$articles}) { my $link = $blog_url . $item->{'year'} . '/' . $item->{'month'} . '/' . $item->{'uri'}; $rss->add_item ( title => $item->{'title'}, link => $link, description => $item->{'body'}, author => $item->{'author'}, comments => "${link}#comments", pubDate => POSIX::strftime("%a, %d %b %Y %H:%M:%S %z (%Z)", gmtime($item->{'epoch'})), category => \@{[split(/, */, $item->{'tags'})]}, ); } print $cgi->header('application/rss+xml'), $rss->as_string; } sub output_sitemap { my $map = WWW::Google::SiteMap->new; $map->pretty(1); $map->add( loc => $blog_url, priority => 1.0, ); my $articles = get_articles( nolimit => 1 ); for my $item (@{$articles}) { my $link = $blog_url . $item->{'year'} . '/' . $item->{'month'} . '/' . $item->{'uri'}; $map->add ( loc => $link, priority => 0.8, ); } my $tagcloud = get_tag_cloud(); for my $item (@{$tagcloud}) { my $link = $blog_url . 'Tags/' . $item->{'tag'}; $map->add ( loc => $link, priority => 0.1 + $item->{'scale'} / 10, ); } print $cgi->header('application/xml'), $map->xml; } sub get_articles { my %args = @_; my $page = 1; my $offset = 0; my $limit_clause; my $where_clause; my $full_text = 0; my $show_comments = 0; $articles_per_page = -1 if $args{'nolimit'}; if ($args{'page'}) { $page = $args{'page'}; $offset = ($page - 1) * $articles_per_page; } if ($args{'year'} && 1900 < $args{'year'} && $args{'year'} < 2036) { $where_clause .= 'WHERE date LIKE \'%' . $args{'year'}; if ($args{'month'} && 0 < $args{'month'} && $args{'month'} <= 12) { $where_clause .= '-' . $args{'month'} . '%\' AND enabled=1 '; if ($args{'uri'}) { $where_clause .= 'AND uri=? AND enabled=1 '; $show_comments=1; } } else { $where_clause .= "\%' AND enabled=1 "; } } elsif ($args{'tag'}) { $where_clause .= "WHERE (tags LIKE ? OR author LIKE ?) AND enabled=1 "; } elsif ($cgi->param('id')) { $where_clause .= 'WHERE id=? AND enabled=1 '; $show_comments=1; } else { $where_clause .= 'WHERE enabled=1 '; $limit_clause = " LIMIT $articles_per_page OFFSET $offset"; # XXX my $query2 = 'SELECT count(*) as total FROM articles WHERE enabled=1'; my $sth2 = $dbh->prepare($query2); $sth2->execute || die $dbh->errstr; my $article_count = $sth2->fetchrow_hashref->{'total'}; $template->param( page_prev => ($page - 1) ) if $article_count > ($offset - $articles_per_page); $template->param( page_next => ($page + 1) ) if $article_count > ($offset + $articles_per_page); } my $query = 'SELECT *, strftime("%s", date) AS epoch FROM articles ' . $where_clause . 'ORDER BY date DESC' . $limit_clause; my $sth = $dbh->prepare($query); if ($args{'uri'}) { $sth->execute($args{'uri'}) || die $dbh->errstr; } elsif ($args{'tag'}) { my $search_tag = '%' . $args{'tag'} . '%'; $sth->execute($search_tag, $search_tag) || die $dbh->errstr; } elsif ($cgi->param('id')) { $sth->execute($cgi->param('id')) || die $dbh->errstr; } else { $sth->execute() || die $dbh->errstr; } my @articles; while (my $result = $sth->fetchrow_hashref) { $result->{'date'} =~ /(\d{4})\-(\d{2})\-\d{2} \d{2}\:\d{2}\:\d{2}/; ($result->{'year'}, $result->{'month'}) = ($1, $2); # cut off readmore if we're on the front page if ($result->{'body'} =~ // && !($args{'uri'} || $args{'more'})) { $result->{'body'} =~ /(.*)\<\!\-\-readmore\-\-\>/s; $result->{'body'} = $1; $result->{'readmore'}++; } $result->{'tag_loop'} = format_tags($result->{'tags'}) if ($result->{'tags'}); my $comments = get_comments(article_id => $result->{'id'}, enabled => 1); $result->{'comments_count'} = scalar(@{$comments}); if ($show_comments) { $result->{'comments'} = $comments; } push(@articles, $result); } return (\@articles); } sub get_archives { my %args = @_; my %history; my @archives; my @archives_compressed; my $current_year = $args{'year'} || ((localtime)[5] + 1900); my $current_month = $args{'month'} || ((localtime)[4] + 1); my %months = ( '01' => 'January', '02' => 'February', '03' => 'March', '04' => 'April', '05' => 'May', '06' => 'June', '07' => 'July', '08' => 'August', '09' => 'September', '10' => 'October', '11' => 'November', '12' => 'December', ); my $query = 'SELECT title, date, uri FROM articles WHERE enabled=1 ORDER BY date DESC'; my $sth = $dbh->prepare($query); $sth->execute || die $dbh->errstr; while (my $result = $sth->fetchrow_hashref) { $result->{'date'} =~ /(\d{4})\-(\d{2})\-\d{2} \d{2}\:\d{2}\:\d{2}/; ($result->{'year'}, $result->{'month'}) = ($1, $2); my $title = $result->{'title'}; if (($result->{'year'} eq $current_year) && ($result->{'month'} eq $current_month) && $result->{'uri'}) { push(@{$history{$result->{'year'}}{$result->{'month'}}->{'uri_loop'}}, { year => $result->{'year'}, month => $result->{'month'}, month_name => $months{$result->{'month'}}, title => $title, uri => $result->{'uri'}, } ); } else { $history{$result->{'year'}}->{$result->{'month'}}->{'count'}++; } $history{$result->{'year'}}->{'count'}++; } for my $year (sort {$b <=> $a} keys %history) { no strict "refs"; for my $month (sort {$b <=> $a} keys %{$history{$year}}) { my $m = { 'year' => $year, 'month' => $month, 'month_name' => $months{$month}, 'count' => $history{$year}->{$month}->{'count'}, }; # check to see if uri_loop exists first if ($history{$year}->{$month}->{'uri_loop'}) { $m->{'uri_loop'} = $history{$year}->{$month}->{'uri_loop'}; } push(@{$history{$year}->{'month_loop'}}, $m) unless ($month eq 'count'); } my $y = { 'year' => $year, 'count' => $history{$year}->{'count'}, }; # check to see if we're showing this year, and that month_loop exists if (($year eq $current_year) && $history{$year}->{'month_loop'}) { $y->{'month_loop'} = $history{$year}->{'month_loop'}; } push(@{$history{'year_loop'}}, $y) unless ($year eq 'count'); } return \@{$history{'year_loop'}}; } sub format_tags { my $tags = shift; my @tags; foreach (split(/, */, $tags)) { push(@tags, { 'tag' => $_ }); } @tags = sort { lc $a->{tag} cmp lc $b->{tag} } @tags; return \@tags; } sub read_comment { if ($cgi->param('recaptcha_challenge_field') && $cgi->param('recaptcha_response_field') && $cgi->param('comment') && $cgi->param('id')) { # test our captcha my $result = verify_captcha( privatekey => $captcha_seckey, remoteip => $cgi->remote_addr(), challenge => $cgi->param('recaptcha_challenge_field'), response => $cgi->param('recaptcha_response_field') ); if ($result->{'success'}) { # save comment my $stmt = "INSERT INTO comments VALUES (NULL, ?, datetime('now', 'localtime'), ?, ?, ?, ?, 0)"; my $sth = $dbh->prepare($stmt); my $comment_name = $cgi->param('name') ? substr($cgi->param('name'), 0, 100) : 'anonymous'; my $comment_email = $cgi->param('email') ? substr($cgi->param('email'), 0, 100) : undef; my $comment_url = $cgi->param('url') ? substr($cgi->param('url'), 0, 100) : undef; my $comment_body = substr(HTML::Entities::encode($cgi->param('comment'), "<>&"), 0, $comment_max_length); my $remoteip = $cgi->remote_addr(); $sth->execute($cgi->param('id'), $comment_name, $comment_email, $comment_url, $comment_body) || die $dbh->errstr; $template->param( message => 'comment awaiting moderation, thank you' ); # send email notification my $smtp = Net::SMTP->new($smtp_server); my $date = POSIX::strftime("%a, %d %b %Y %H:%M:%S %z (%Z)", localtime); $smtp->mail($blog_owner); $smtp->to($blog_owner); $smtp->data(); $smtp->datasend("From: $smtp_sender\n"); $smtp->datasend("To: $blog_owner\n"); $smtp->datasend("Date: $date\n"); $smtp->datasend("Subject: $blog_title comment submission\n"); $smtp->datasend("\n"); $smtp->datasend("You have received a new comment submission.\n"); $smtp->datasend("\n"); $smtp->datasend("From: $comment_name\n"); $smtp->datasend("IP: $remoteip\n"); $smtp->datasend("Date: $date\n"); $smtp->datasend("Comment: \"$comment_body\"\n"); $smtp->datasend("\n"); $smtp->datasend("Moderate comments at ${blog_url}admin.cgi?view=moderate\n"); $smtp->dataend(); $smtp->quit; } else { my $error; if ($result->{'error'} eq 'incorrect-captcha-sol') { $error = 'failed challenge, please try again'; } else { $error = 'Error: ' . $result->{'error'} . ', please report to site admin'; } $template->param( error => $error ); $template->param( name => $cgi->param('name') ); $template->param( email => $cgi->param('email') ); $template->param( url => $cgi->param('url') ); $template->param( comment => $cgi->param('comment') ); $template->param( id => $cgi->param('id') ); $template->param( comment_form => 1 ); } } $template->param( captcha_api_server => $captcha_api_server ); $template->param( captcha_pubkey => $captcha_pubkey ); } sub verify_captcha { my %args = @_; my $http = HTTP::Lite->new(); $http->prepare_post( \%args ); $http->request( 'http://api-verify.recaptcha.net/verify' ); if ( $http->status eq '200' ) { my ( $answer, $message ) = split( /\n/, $http->body, 2 ); return { success => 1 } if ( $answer =~ /true/ ); return { success => 0, error => $message }; } else { return { success => 0, error => 'recaptcha-not-reachable' }; } } sub get_comments { my %args = @_; my $query = 'SELECT * FROM comments WHERE article_id=? AND enabled=? ORDER BY date ASC'; my $sth = $dbh->prepare($query); $sth->execute($args{'article_id'}, $args{'enabled'}) || die $dbh->errstr; my @comments; while (my $result = $sth->fetchrow_hashref) { push(@comments, $result); } return \@comments; } sub get_tag_cloud { my $query = 'SELECT tags FROM articles WHERE enabled=1'; my $sth = $dbh->prepare($query); $sth->execute || die $dbh->errstr; # create a frequency table keyed by tag my %freq; while (my $result = $sth->fetchrow_hashref) { map { $freq{$_}++ } split(/, */, $result->{'tags'}); } # calculate the scaling denominator my @tags = sort { $freq{$b} <=> $freq{$a} } keys %freq; @tags = splice @tags, 0, $max_tags_in_cloud; my $denominator = $freq{ $tags[0] } == $freq{ $tags[-1] } ? ( 1 / 5 ) : ( $freq{ $tags[0] } - $freq{ $tags[-1] } ) / 5; # build an HTML::Template friendly data structure my @tag_cloud_data = (); for my $tag (sort { lc $a cmp lc $b } @tags) { my %row; $row{'tag'} = $tag; $row{'scale'} = int( ( $freq{$tag} - $freq{ $tags[-1] } ) / $denominator ); push(@tag_cloud_data, \%row); } return( \@tag_cloud_data ); }