The module
package ForumDB;
use strict;
use warnings;
use base qw/ DBIx::Class /;
__PACKAGE__->load_components(qw/ CDBICompat Core PK::Auto DB /);
my $DB = "./forum_db.sqlite";
# or more likely to work...
$DB = "/tmp/forum_db.sqlite";
my @DSN = ("dbi:SQLite:dbname=$DB",
'', '',
{ AutoCommit => 1, RaiseError => 1 });
__PACKAGE__->connection(@DSN);
__PACKAGE__->set_sql(_table_pragma => 'PRAGMA table_info(__TABLE__)');
__PACKAGE__->set_sql(_create_me => 'CREATE TABLE __TABLE__ (%s)');
__PACKAGE__->storage->dbh->do("PRAGMA synchronous = OFF");
__PACKAGE__->set_table("forum");
__PACKAGE__->columns(All => qw/ id parent title body time /);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->belongs_to('parent' => __PACKAGE__);
__PACKAGE__->has_many('replies' => __PACKAGE__, 'parent',
undef,
{ order_by => 'time' } );
sub set_table {
my ($class, $table) = @_;
$class->table($table);
$class->_create_table;
}
sub _create_table {
my $class = shift;
my @vals = $class->sql__table_pragma->select_row;
$class->sql__create_me($class->create_sql)->execute unless @vals;
}
sub create_sql {
# table name of "forum"
return q{
id INTEGER PRIMARY KEY,
parent INTEGER REFERENCES __TABLE__('id'),
title VARCHAR(40),
body TEXT,
time INTEGER
}
}
sub parents {
my ( $self, @parents ) = @_;
my $parent = $self->parent;
return @parents unless $parent;
push @parents, $parent;
die "Endless lineage loop suspected!" if @parents > 100;
$parent->parents(@parents);
}
1;
The cgi
use strict;
use warnings;
no warnings 'uninitialized';
use CGI qw( :standard );
# use CGI::Carp "fatalsToBrowser"; <-- If you need it
use ForumDB;
use Template;
my $rs = ForumDB->search();
eval {
$rs->delete_all() if param('DELETE ALL!');
}; # this delete acts a bit funny sometimes
if ( param('add') ) {
my $post = $rs->create({ title => ucfirst("title " x rand(15)),
time => time(),
body => ucfirst("asdf " x rand(100))
});
$post->update();
}
elsif ( my $id = param('reply_id') )
{
my $parent = $rs->find($id);
die unless $parent;
my $post = $rs->create({ title => ucfirst("title " x rand(15)),
parent => $parent,
time => time(),
body => ucfirst("asdf " x rand(100))
});
$post->update();
}
print redirect( url(), 302 ) if param();
print CGI::header();
my $tt2 = Template->new({
RECURSION => 1, # This is necessary!
TRIM => 1,
});
$tt2->process(\*DATA,
{ posts => [ $rs->search() ],
cgi => CGI->new(),
})
or die $tt2->error();
exit 0;
=head1 Threaded forum style posts using a single table-
Using L<SQLite>, L<Template::Toolkit|Template>, and L<DBIx::Class>.
=head2 Included
=over 4
=item * Script: forum.cgi
Template based demo script.
=item * Module: ForumDB.pm
Instantiates the DB with SQLite. Provides the DBIx::Class goodies.
=back
This is a proof of concept. It works though and should show an obvious
path for how to put together a more serious version.
=head2 Requires
Itself (the ForumDB.pm and forum.cgi), SQLite, L<CGI>, L<CGI::Carp>,
L<Template>, and L<DBIx::Class>.
=head2 Notes
The "time" column is not actually used here. You should refer to the
documentation on L<DBIx::Class>, L<Template::Toolkit|Template>,
and such, not on the code presented in ForumDB. It is a pastiche
of test-style code and does not represent good practices for productio
+n.
=head2 License
Copyright 2007. Same terms as Perl. If ths code burns down your house,
gets your cat preganant, kills your favorite movie star, or gives you
lice the size of giant isopods I am not responsible except where
enforced by law.
=head2 Author
Your Mother. You can't serve me if you don't know my real name!
=cut
__END__
[%#------------------------------------------------------------%]
[% BLOCK display_post %]
[%-DEFAULT
depth = 0
title = '[untitled]'
recurse = 0
%]
[%-RETURN IF recurse AND post.parent AND ! depth %]
[%-depth = depth + 1 %]
[% bgcolor = 255 - ( depth * 10 ) %]
<div class="post" style="background-color:rgb([%bgcolor%],[%bgcolor%],
+[%bgcolor%])">
<p><b>[% post.title | html %]</b></p>
[% post.body | html | html_para %]
<p style="text-align:right;font-size:xx-small">
<a href="?reply_id=[% post.id %]">reply</a>
</p>
[%-IF recurse %]
[%-FOR reply IN post.replies %]
[%-INCLUDE display_post
post = reply
depth = depth
%]
[%-END %]
[%-END %]
</div>
[% END %]
[%#------------------------------------------------------------%]
<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml"
lang="en-US" xml:lang="en-US">
<head>
<title>Threaded forum demo with DBIx::Class</title>
<style type="text/css" media="screen">
body, html {
width:600px; margin:10px auto;
font: 10px/12px verdana,sans-serif;
}
p {
margin: 2px 0;
padding: 0 2px;
}
.post {
border: 1px solid #aab;
color:#0c0c3c;
padding:0 0 0 4px;
margin:5px 0 3px 3px;
overflow:hidden;
}
.post > .post {
border-right: 0;
margin-top: 1ex;
}
</style>
</head>
<body>
<form method="post" action="[% cgi.url("-absolute" => 1) %]">
<input type="submit" name="add" value="Add Post" />
<input type="submit" name="DELETE ALL!" value="DELETE ALL!" />
</form>
<hr/>
[% FOR post IN posts %]
[%- PROCESS display_post
recurse = 1
depth = 0 -%]
[% END %]
</body>
</html>
|