#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
use strict;
use lib '.';
use lib 'module';
require DBI;
require fobj;
my $f=new fobj;

$f->start;
(print "Sorry, your user name and or password is non existant or not v
+alid") unless $f->valid;


$f->template
('forum.tmpl',    
    threads        => construct_rows(),
    section_nav    => construct_section_nav(),
);

$f->finish;

sub construct_rows
{
    my $alt=0;
    
    my $sql="SELECT `cid`,`name`,`descr` FROM ".$f->conf('pre')."categ
+ories";
    my $pn=$f->dbh->prepare($sql);
    $pn->execute;
    my ($name,$desc,$cid);
    $pn->bind_columns(\$cid,\$name,\$desc);
    
    $sql="SELECT `author`,`time` FROM ".$f->conf('pre')."posts WHERE `
+cid`=? ORDER BY `time` DESC LIMIT 0,1";
    my $qn=$f->dbh->prepare($sql);
    my ($auth,$time);
    $qn->execute(0);
    $qn->bind_columns(\$auth,\$time);

    $sql="SELECT COUNT(pid) FROM ".$f->conf('pre')."posts WHERE `cid`=
+?";
    my $rn=$f->dbh->prepare($sql);
    my ($posts);
    $rn->execute(0);
    $rn->bind_columns(\$posts);
    
    my @cats;
    while($pn->fetch)
    {
        $alt=$alt?0:1;
        
        $qn->execute($cid);
        $qn->fetch;
        
        $rn->execute($cid);
        $rn->fetch;
        
        my $last=$auth.' - '.$f->date_diff($time);
        push @cats,
        (    
            {     
                name    => $name,
                cid        => $cid,
                posts    => $posts,
                last    => $last,
                alt        => $alt,
                desc    => $desc,
            }
        );
    }
    $pn->finish;
    $qn->finish;
    $rn->finish;
    return \@cats;
}

sub construct_section_nav
{
    return "<a href='forum.pl'>/index</a>";
}

#------------------------------
# fobj.pm
#------------------------------

use strict; #d'uh
use CGI::Carp qw(fatalsToBrowser);     #To see errors while developing
+, 
                                    #should probably be taken out of
                                    #production code;
use CGI::Carp;

package fobj;
sub new
{
    return bless my $x={};
}

#########################################################
# "Start": Generally called at the beginning, just after
# "new", it calls template('header.html'); and then
# calls _start_benchmark;
#########################################################

sub start
{
    my $self=shift;
    my %opts=@_;
    my $i=0;
    my $stylesheet=$self->stylesheet;
    my $date=$self->date;
    print "Content-type:text/html\n\n";
        
    my $sql="UPDATE `".$self->conf('pre')."members` SET `lastvisit`=no
+w() WHERE `name`=?";
    my $pn=$self->dbh->prepare($sql);
    $pn->execute($self->env('name'));
    $pn->finish;
    
    my $page=$self->cgi('get','tid') ne ''?'thread.pl':'cat.pl';
    $self->template
    ('header.tmpl',
        date            => $date,
        pm            => $self->_check_pm,
        stylesheet    => $stylesheet,
    );
    $self->start_benchmark;
}

    sub _check_pm

    {
        my $self=shift;
        my $sql="SELECT COUNT(mid) FROM ".$self->conf('pre')."pm WHERE
+ `target`=? AND `pmread`=0";
        my $pn=$self->dbh->prepare($sql);
        $pn->execute($self->env('name'));
        my $x;
        $pn->bind_columns(\$x);
        $pn->fetch;
        $pn->finish;
        if($x){return "<script>popup(100,100,300,300,'pm.pl')</script>
+";}
        else{return "";}
    }    

sub date
{
    my $self=shift;
    my $sql="SELECT `lastvisit` FROM `".$self->conf('pre')."members` W
+HERE `name`=?";
    my $pn=$self->dbh->prepare($sql);
    my ($date);
    $pn->execute($self->env('name'));
    $pn->bind_columns(\$date);
    $pn->fetch;
    $pn->finish;
    return $self->date_diff($date);
}

sub stylesheet
{
    my $self=shift;
    my $stylesheet;
    my $sql="SELECT `stylesheet`,`personalsheet` FROM `".$self->conf('
+pre')."members` WHERE `name`=?";
    my $pn=$self->dbh->prepare($sql);
    my ($style,$perstyle);
    $pn->execute($self->env('name'));
    $pn->bind_columns(\$style,\$perstyle);
    $pn->fetch;
    $pn->finish;
    
    if($style ne '')
    {
        my $sql="SELECT `data` FROM `".$self->conf('pre')."styles` WHE
+RE `id`=? limit 0,1";
        my $pn=$self->dbh->prepare($sql);
        $pn->execute($style);
        $pn->bind_columns(\$stylesheet);
        $pn->fetch;
    }
    
    elsif($perstyle ne '')
    {
        $stylesheet=$perstyle;
    }
    else
    {
        $stylesheet='@import url("styles/forum.css"); ';
    }
    
    return $stylesheet;
}

#########################################################
# Typically the last subroutine to be called, it calls
# _end_benchmark and passes that value to the
# template call, in the form of 
# template('footer.html',time=>$time);
#########################################################

sub finish
{
    my $self=shift;
    my $time=$self->end_benchmark($self->{t}) if defined $self->{t};
    $self->template('footer.tmpl',time=>$time);
}

#########################################################
# "start_benchmark": Creates a new Benchmark in $obj->{t}
#########################################################

sub start_benchmark
{
    require Benchmark;
    my $self=shift;
    $self->{t}=new Benchmark;
}
    
#########################################################
# Basically a wrapper around Template.pm, 2 args, first 
# arg is the name of the template two open, second arg is
# a hash of values to replace in the template, replaces
# <TMPL_VAR NAME="$key"> with $value, also sets up
# a few other default substitutions.
#########################################################
sub template
{
    my $self=shift;
    require Template;
    my $what=shift;
    if($what!~m!/|\\!){$what=$self->conf('tmpl_dir').$what;}
    my %rep=@_;
    $self->_set_rep(\%rep);
    my $template = HTML::Template->new    
    (
        filename => $what,
        die_on_bad_params => 0
    );
    $template->param(\%rep);
    print $template->output;
}

    sub _set_rep
    {
        my $self=shift;
        my $rep=shift;
        my $sql="SELECT `style` FROM `".$self->conf('pre')."members` W
+HERE ".
        "`name`=?";
        my $pn=$self->dbh->prepare($sql);
        my $temp;
        $pn->execute($self->env('name'));
        $pn->bind_columns(\$temp);
        $pn->fetch;
        $pn->finish;
        $rep->{style}='styles/'. ($temp || 'forum.css');
        $rep->{name}=$self->env('name');
    }

sub cgi
{
    require Lite;
    my $self=shift;
    my $c=CGI::Lite->new;
    $self->{get_cgi}=$c->parse_form_data('GET') unless (defined $self-
+>{get_cgi});
    $self->{post_cgi}=$c->parse_form_data('POST') unless (defined $sel
+f->{post_cgi});
    my ($which,$what) =@_;
    unless(defined $what){return $self->{$which.'_cgi'};}
    elsif($which && $what){return $self->{$which.'_cgi'}->{lc $what};}
}

sub dbh
{
    my $self=shift;
    require DBI;
    unless(defined $self->{dbh})
    {
        $self->{dbh}=
        DBI->connect
        (
        "DBI:mysql:".$self->conf('db_name'),
        $self->conf('db_user_name'),
        $self->conf('db_user_pass'),
        {RaiseError => 1}
        );
    }
    return $self->{dbh};
}

#########################################################
# "conf": the configuration function. This function creates
# a hash out of 'db.conf', in the form of $key = $value;
# It takes one or zero parameters, if one parameter, it 
# returns whatever the parameter corresponds to in the
# db.conf file, and if zero parameters, it returns the
# hash itself.
#########################################################

sub conf
{
    my $self=shift;
    my $what=shift;
    my %temp;
    if(defined $self->{conf})
    {
        return (defined $what)?$self->{conf}{$what}:$self->{conf};
    }
    
    else
    {
        open C,'<db.conf' or CGI::Carp::croak "Cant open db.conf for r
+ead";
        for(<C>){/([\w\d\_]+)\s*=\s*(.*)/;$temp{$1}=$2;}
        $self->{conf}={%temp};
        return (defined $what)?$self->{conf}{$what}:$self->{conf};
    }
}

#########################################################
# Similar to the above function, except this function
# works on cookies instead of db.conf, and a few other
# values. Takes one or zero parameters, if one parameter
# it returns the value of the cookie where 
# cookie_name eq $parameter, or if zero, it returns the
# hash of cookies itself.
#########################################################

sub env
{
    my $self=shift;
    my $targ=shift;
    unless(defined $self->{cookie}){$self->{cookie}=$self->_cookie;}
    unless(defined $self->{env}){$self->_define_env;}
    return (defined $targ)?
        (
            defined $self->{env}{$targ}?
                $self->{env}{$targ}
                :
                $self->{cookie}{$targ}
        )
        :
        $self->{env};
}    
    sub _define_env
    {
        my $self=shift;
        my $sql="SELECT `admin`,`avatar`,`sig`,`threadsperpage`,`posts
+perpage` FROM `".
            $self->conf('pre')."members` WHERE `name`=? LIMIT 0,1";
        my ($admin,$av);
        my $pn=$self->dbh->prepare($sql);
        $pn->execute($self->{cookie}{name});
        $pn->bind_columns
            (
                \$self->{env}{admin},
                \$self->{env}{avatar},
                \$self->{env}{sig},
                \$self->{env}{threadsperpage},
                \$self->{env}{postsperpage},
            );
        $pn->fetch;
        $pn->finish;
        $self->{env}{ignored}=$self->__ignored();
    }
            sub __ignored
            {
                my $self=shift;
                my $sql="SELECT `name` FROM `".$self->conf('pre')."ign
+ored` WHERE `user`=?";

                my $pn=$self->dbh->prepare($sql);
                $pn->execute($self->env('name'));
                $pn->bind_columns( \( my $name) );
                
                my %i;
                while($pn->fetch)
                {
                    $i{$name}=1;
                }
                $pn->finish;
                
                return \%i;
            }

    sub _cookie
    {
        require Lite;
        my $lite=CGI::Lite->new;
        return $lite->parse_cookies;
    }

#########################################################
#"end_benchmark": takes a benchmark object, creates a
# new one, and returns a nicely formatted string
# containing the difference between the two benchmarks
#########################################################
    
sub end_benchmark
{
    require Benchmark;
    my $t2=new Benchmark;
    my $self=shift;
    my $t1=shift;
    my $td = Benchmark::timediff($t1, $t2);
    return Benchmark::timestr($td);
}

sub date_diff
{
    $_=shift;
    my ($self,$date);
    (ref $_ eq 'fobj')?($self=$_ and $date=shift):($date=$_);
    require Pcalc;
    return " " unless $date;
    my @date;
    push @date,substr($date,0,4,'');
    for my $i(0..int (length $date)/2){push @date,substr($date,0,2,'')
+;}
    pop @date;
    my @diff=reverse Date::Pcalc::Delta_DHMS(@date,Date::Pcalc::Today_
+and_Now());
    return "[$diff[0]s:$diff[1]m:$diff[2]h:$diff[3]d]";
}

sub valid
{
    my $self=shift;
    (print "Error, name/pass not found. <a href='book.pl?action=in' st
+yle='color:orange;'> Log In</a>" and exit) unless ($self->env('name')
+ ne '' && $self->env('pw') ne '');
    my $sql="SELECT `pw` FROM `".$self->conf('pre')."members` WHERE `n
+ame`=?";
    my $pn=$self->{dbh}->prepare($sql);
    $pn->execute($self->env('name'));
    my $pw;
    $pn->bind_columns(\$pw);
    $pn->fetch;
    $pn->finish;
    (print "Error, invalid name/pass <a href='book.pl?action=in' style
+='color:orange;'> Log In</a>" and exit) unless ($pw eq $self->env('pw
+'));
    return 1;
}

sub DESTROY 
{
    my $self=shift;
    $self->{dbh}->disconnect if (defined $self->{dbh} && ref $self->{d
+bh} eq 'DBI::db');
}

sub AUTOLOAD
{
    shift;
    CGI::Carp::croak "Content-type:text/html\n\n
    You attempted to call $fobj::AUTOLOAD(".join(',',@_).");
    This sub doesnt exist.\n";
}

1; # is the loneliest number..
[download]