view release on metacpan or  search on metacpan

Blog.pm  view on Meta::CPAN

package Apache::Blog::Entry;
use File::Basename;
use Apache::File;
use Date::Manip;
use POSIX ();

use strict;

BEGIN {
	# this comes from Date::Manip. don't know if it should be in the
	# public version. it should probably be a configuration option
	&Date_Init("TZ=BST");
}

# we have a class that represents an entry. then we can call methods
# like $entry->title and $entry->date in the main Apache::Blog class and
# not have to worry about the content of text files there.
sub new {
	my ($class, $filename) = @_;

	my $fh = Apache::File->new( $filename );

	# first line is the short name
	my $short_name = <$fh>;

	# second line is the date
	my $date = <$fh>;

	# the rest is the entry
	my $entry;
	{ local $/=undef;
	  $entry = <$fh>;
	};

	# get the unixtime of the entry too (%s is the Date::Manip way
	# of saying "seconds since the epoch")
	my $unixtime = Date::Manip::UnixDate($date ,'%s');

	# and fix up the date
	$date = POSIX::strftime( '%a %d %b %y %H:%M', localtime $unixtime );

	# see if we can get any comments
	my $comments_ref = [];
	if (-d "$filename-comment") {
		my @comments = Apache::Blog::Entry->get_all( "$filename-comment" );
		$comments_ref = \@comments;
	} # end comment if


	# store those results (wonder if there's a better way to count
	# words than scalar( @{[split /\s+/, $entry]} )
	my %self = (  date => $date,
		      unixtime => $unixtime,
		      entry => $entry,
		      short_name => $short_name,
		      filepath => $filename,
		      filename => basename( $filename ),
	              wc => scalar( @{[split /\s+/, $entry]} ), 
		      comments => $comments_ref,
		   );

	return bless(\%self, $class);
} # end new

sub date { return shift->{date} };
sub unixtime { return shift->{unixtime} };
sub short_name { return shift->{short_name} };
sub filename { return shift->{filename} };
sub filepath { return shift->{filepath} };
sub wc { return shift->{wc} };
sub comments { return @{ shift->{comments} } };

# does simple html-formatting of the plain text
sub entry {
	my $self = shift;

	my $text = $self->{'entry'};

        # make UL lists work (perhaps)
	# there's bound to be a better way of doing this
        $text =~ s/^(\s*)\* (.*)$/$1<li>$2<\/li>/mg;
        if ($text =~ /<li>/) {
                $text =~ s/<li>/<ul><li>/;
                $text = reverse $text;
                $text =~ s/>il\/</>lu\/<>il\/</;
                $text = reverse $text;
        } # end it
 
        # bold?
        $text =~ s/\*([^*]+)\*/<b>$1<\/b>/g;	

	# blank lines -> <p>
	$text =~ s/^\s*$/\n<p>\n/mg;

	return $text;

} # end entry

# gets all of the entries in a directory
sub get_all {
	my ($class, $dir) = @_;

	# get all of the details of all of the entries
	opendir DIR, $dir;
	my @entries = map { Apache::Blog::Entry->new( $dir."/".$_ ) }
	              grep !/\.html$/ && !/^\./ && !(-d $dir."/".$_), readdir DIR;
	closedir DIR;

	# now sort those
	my @out_entries;
	foreach my $entry (sort { $b->unixtime <=> $a->unixtime } @entries) {
		push @out_entries, $entry;
	} # end foreach

	return @out_entries;
} # end get_all



package Apache::Blog;

use strict;

use vars qw( $VERSION );
$VERSION = '0.03';

use Apache::Constants; # qw(:common);
use Apache::Request;
use HTML::Template;
use File::Basename;

use strict;

# this pretty much just dispatches the request to a different handler,
# depending on what's actually been requested.
sub handler {
	my $r = shift;

	return &handle_comment($r) if ($r->filename =~ /post-comment$/ );
	return &handle_older($r) if ( $r->filename =~ /older\.html$/ );
	if (-d $r->filename) {
		# they've just asked for the directory - need to send newest entry
		my @entries = Apache::Blog::Entry->get_all( $r->filename );
		my $latest = $entries[0];

		$r->filename( $latest->filepath );
	}

	return handle_file($r);

	return DECLINED;

} # end handler

# we do this if it's an entry we want to show
sub handle_file {
	my $r = shift;

	my $dir = dirname( $r->filename );

	my $template = $dir."/entry-template.html";

	# return declined if the entry template doesn't exist
	if (!-e $template) {
		return DECLINED;
	} # end if

	$template = HTML::Template->new( filename => $template, die_on_bad_params => 0 );

	my $entry = Apache::Blog::Entry->new( $r->filename );