Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Threaded forum with single DB table

by Your Mother (Archbishop)
on Sep 08, 2007 at 08:37 UTC ( #637805=sourcecode: print w/replies, xml ) Need Help??
Category: CGI Programming
Author/Contact Info
Description: While this is a demo, it works and shows how to add lineage to a single table as well as recursively call it in TT2. There is a module + a cgi that uses it. There is a bit of POD with the cgi. (Update: cleaned up lines/comments in a couple places; and now with fewer Toolkites! Update: 22 July 2008, updated Pod a bit.)
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>

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://637805]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (7)
As of 2021-01-20 11:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?