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;
[download]

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>
[download]