#!/usr/bin/perl -w use strict; use POSIX qw(strftime); use Time::Local; use URI::Heuristic; use Text::Wrap; use vars qw/$CGIPath $blogPath $documentRoot $documentURL $sidebarFile $syntaxChecksFile $styleSheet $followup_root $heading $title $admin_email/; $CGIPath = '/home/adam/public_html/cgi-bin'; $blogPath = '/adam/cgi-bin/weblog.pl'; $documentRoot = '/home/adam/public_html/blog'; $followup_root = $documentRoot . '/followups'; $documentURL = '/~adam/blog/'; $sidebarFile = "$documentRoot/sidebar"; $syntaxChecksFile = "$documentRoot/syntax_checks"; $title = "Adam Kessel's Weblog"; $heading = "Adam Kessel’s Weblog"; $styleSheet = "/~adam/style.css"; $admin_email = "adam\@bostoncoop.net"; $Text::Wrap::columns = 100; # for wrapping HTML sub PrintFollowUps { my $entry_name = shift; my $followup_text = ""; my $date_string; $entry_name =~ s<^$documentRoot/><>g; if (-e "$followup_root/$entry_name") { open IN, "$followup_root/$entry_name" || return ""; $followup_text = ">\nLinked Responses ) { my ($epoch, $url, $comment) = m/^(.*?)\t(.*?)\t(.*)$/; $date_string = &EpochToShortDate($epoch); $followup_text .= " class='responses'>$comment \n$date_string
"; close IN; } return $followup_text; } sub AddFollowUp { my $file_name = shift; my $url = shift; my $comment = shift; my $epoch = timelocal(localtime); ($url = URI::Heuristic::uf_urlstr($url) and $comment and $file_name) || return 0; open OUT, ">>$followup_root/$file_name" || return 0; print OUT $epoch . "\t" . $url . "\t" . $comment . "\n"; close OUT; 1; } sub GetMetaData { open IN, shift || return; $_ = join('',); close IN; my %metadata = (); my @matches = m{<%(.*)\s*[:=]\s*(.*?)\s*>}gi; while( @matches ) { my $key = lc shift @matches; if ($key eq "title") { $metadata{$key} = [ shift @matches ]; } else { my @values = split( /\s*,\s*/, shift @matches ); $metadata{$key} = [@values]; } } return %metadata; } sub GetTopicStringFromMetaData { my $topicArray = shift; $topicArray or return ""; my $topicString = "Topics: "; foreach (@{$topicArray}) { my $topic_filename = &MakeTopicFilename($_); $topicString .= "" . $_ . ", "; } $topicString =~ s/, $//g; $topicString .= ""; return $topicString; } sub MakeTopicFilename { my $topic_filename = lc shift; $topic_filename =~ s/ /_/g; $topic_filename; } sub MetaDateToEpoch { $_ = shift; my ($year, $mon, $mday, $hour, $min) = m/^(\d{2,4})\.(\d{1,2})\.(\d{1,2})\.(\d{1,2})\.(\d{2})/; $year < 100 and $year += 100 or $year > 1900 and $year -= 1900; # timelocal wants dates since 1900 $mon -= 1; timelocal(0, $min, $hour, $mday, $mon, $year); } sub EpochToBlogDate { $_ = shift; strftime("%A, %B %d, %Y at %I:%M %p", localtime($_)); } sub EpochToShortDate { $_ = shift; strftime("%D %H:%M", localtime($_)); } sub EpochToDateOnly { $_ = shift; strftime("%D", localtime($_)); } # Returns the timestamp of the specified blog file, either from the last modified # or from embedded metadata (metadata always takes priority) sub GetBlogFileDate { my $current_file_name = shift; my $return_value = 0; my %meta_data; (-e $current_file_name) || return $return_value; $return_value = (stat($current_file_name))[9]; %meta_data = &GetMetaData($current_file_name); if ($meta_data{"date"}) { $return_value = &MetaDateToEpoch($meta_data{"date"}[0]); } $return_value; } # Despite its name, FastGrep is probably not all that fast; # I think something needs to be done to precompile the pattern--although I wasn't able to figure it out. # It is passed a search string and the material to search; # it parses out the search string by spaces. In order to return true, all term smust appear in the material. # (i.e., 'google' type searching) sub FastGrep { my $search_string = shift; my @search_material = @_; my $found = 1; my $code; my @search_string = split(/\s/,$search_string); foreach my $current_search (@search_string) { $found = 0 unless grep /$current_search/i, @search_material; } $found; } sub ShowSearchResults { my $search_string = shift; my %meta_data; my @results; foreach my $blog_file (<$documentRoot/*>) { my $entry_name = $blog_file; open IN, $blog_file; push @results, $blog_file if &FastGrep($search_string, ); close IN; } print "Search Results\n"; print "Sorry, there were no results. You can try a new search if you want. Note that all terms must match; if you want to do an “or” search, try using a | between your search terms.
" . &StringSearchBox unless @results; foreach my $current_file_name (@results) { my ($description, $topics) = &BlogItemSummary($current_file_name); print &UniversalFormat($description); } } sub StringSearchBox { <'$blogPath' method='post'> 'feedbackform'> 'submit' value='Search:' /> 'text' name='search' size='20' maxlength='40' />
EOF } sub BlogItemSummary { my $blog_file = shift; my ($item_description, %meta_data); my $blog_timestamp = &GetBlogFileDate($blog_file); my @topics; %meta_data = &GetMetaData($blog_file); return "" unless $meta_data{"title"}; $blog_file =~ s<^$documentRoot/><>; $item_description="$blog_file
>" . $meta_data{"title"}[0] . '
' . EpochToBlogDate($blog_timestamp) . ' '; if (&GetTopicStringFromMetaData($meta_data{"keywords"})) { $item_description .= "
" . &GetTopicStringFromMetaData($meta_data{"keywords"}) . "\n"; foreach (@{$meta_data{"keywords"}}) { push @topics, $_; } } return ($item_description, @topics); } sub UniversalFormat { $_ = ">" . join('',@_) . "<"; my $string = $_; while ($string =~ s{<%embed:(.*?)>}{ REPLACETEXTHERE}i) { my $embedded_blog_link = $1; my $embedded_document = &show($documentRoot . "/" . $embedded_blog_link,1); $embedded_document =~ s{blogtitle}{blogsubtitle}g; $embedded_document =~ s{(blogsubtitle.*?>)(.*?)(<)} {$1s="blogsubtitle" href="$blogPath?rightframe=$embedded_blog_link">$2$3}g; $string =~ s/REPLACETEXTHERE/$embedded_document/; } $_ = $string; s{<%blog:(.*?)>} {$1$&}g; s[<%blogimage:(.*?)>] [
${documentURL}image_$1" alt="$1" />$&]g; s[<%rimage:(.*?)>] [${documentURL}image_$1" alt="$1" class="insetright" />$&]g; s[<%limage:(.*?)>] [${documentURL}image_$1" alt="$1" class="insetleft" />$&]g; s[<%image:(.*?)>] [${documentURL}image_$1" alt="$1" class="insetcenter" />$&]g; s{\s *([^>]*?)>} {$documentURL$1.pdf">PDF version [info]}gi; s{\s*([^>]*?)>} {$blogPath?rightframe=$1">}g; s{\s *([^>]*?)>} {$documentURL$1">}g; s{(.*
)} {WEBLOGPLACEHOLDER}is; # Remove a
section, if there is one, to be put back afterwards my $preSection = $1; s{
}{
}gi; s{
}{
}gi; s{(]*[^/])>}{$1 />}gi; s{&([^;]*? )}{&$1}g; # Only replace & with & when the & isn't already an HTML escape sequence! while (s{>([^<]*?)``(.*?)''(.*?)<} {>$1“$2”$3<}gs) {}; while (s{>([^<]*?)" ([^"]*?)"(.*?)<} {>$1“$2”$3<}gs) {}; while (s{>([^<]*?)`([^']*)'(.*?)<} {>$1‘$2’$3<}gs) {}; while (s{>([^<]*?\s)'([^']*)'([\s,;\.].*?)<} {>$1‘$2’$3<}gs) {}; while (s{>([^<]*?)'} {>$1’}gs) {} s/WEBLOGPLACEHOLDER/$preSection/; # Put back any removed section.
s/^>|<$//g; s{<%(.*?)>} {}g; $_; } 1;
syntax highlighted by Code2HTML, v. 0.9.1