The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Labyrinth::Plugin::Articles::Diary;

use warnings;
use strict;

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

=head1 NAME

Labyrinth::Plugin::Articles::Diary - Diary plugin for Labyrinth framework

=head1 DESCRIPTION

Contains all the diary handling functionality for Labyrinth.

=cut

# -------------------------------------
# Library Modules

use base qw(Labyrinth::Plugin::Articles);

use Clone qw(clone);
use Time::Local;
#use Data::Dumper;

use Labyrinth::Audit;
use Labyrinth::DBUtils;
use Labyrinth::DTUtils;
use Labyrinth::Globals;
use Labyrinth::IPAddr;
use Labyrinth::Metadata;
use Labyrinth::MLUtils;
use Labyrinth::Session;
use Labyrinth::Support;
use Labyrinth::Variables;
use Labyrinth::Writer;

# -------------------------------------
# Variables

# type: 0 = optional, 1 = mandatory
# html: 0 = none, 1 = text, 2 = textarea

my %fields = (
    articleid   => { type => 0, html => 0 },
    quickname   => { type => 1, html => 0 },
    title       => { type => 1, html => 1 },
);

my (@mandatory,@allfields);
for(keys %fields) {
    push @mandatory, $_     if($fields{$_}->{type});
    push @allfields, $_;
}

my $LEVEL       = ADMIN;
my $SECTIONID   = 6;

my %cfields = (
    articleid   => { type => 0, html => 0 },
    commentid   => { type => 0, html => 0 },
    subject     => { type => 0, html => 1 },
    body        => { type => 1, html => 3 },
    author      => { type => 1, html => 1 },
    href        => { type => 0, html => 1 },
    publish     => { type => 0, html => 0 },
);

my (@cmandatory,@callfields);
for(keys %cfields) {
    push @cmandatory, $_        if($cfields{$_}->{type});
    push @callfields, $_;
}

my ($BLOCK,$ALLOW) = (1,2);

# -------------------------------------
# Public Methods

=head1 PUBLIC INTERFACE METHODS

=over 4

=item Archive

=item List

=item Meta

=item Cloud

=item Search

=item Item

=item Comment

=item LatestComments

=item Posted

=back

=cut

sub Archive {
    my $oldid = $cgiparams{sectionid};
    $cgiparams{sectionid} = $SECTIONID;
    $cgiparams{section} = 'diary';

    shift->SUPER::Archive();
    $tvars{articles} = undef;
    $cgiparams{sectionid} = $oldid; # reset
}

sub List {
    $cgiparams{sectionid}          = $SECTIONID;
    $settings{data}{article_limit} = $settings{diary_limit};
    $settings{data}{article_stop}  = $settings{diary_stop};

    if($cgiparams{volume}) {
        $settings{where} = 'createdate > ' . _vol2date($cgiparams{volume}) .
                      ' AND createdate < ' . _vol2date($cgiparams{volume} + 1);
    }

    shift->SUPER::List();
    _count_comments();

    # see if we can do next and previous
    my $this = 0;
    if($cgiparams{volume}) {
        for my $vol (@{$tvars{archive}{diary}}) {
            if($cgiparams{volume} == $vol->{volumeid}) {
                $this = 1;
            } else {
                $tvars{archive}{volumes}{prev} = $vol   if(!$this);
                $tvars{archive}{volumes}{next} ||= $vol if($this);
            }
        }
    }
}

sub Meta {
    return  unless($cgiparams{data});

    my $oldid = $cgiparams{sectionid};
    $cgiparams{sectionid}          = $SECTIONID;
    $settings{data}{article_limit} = $settings{diary_limit};
    $settings{data}{article_stop}  = $settings{diary_stop};

    shift->SUPER::Meta();
    _count_comments();
    $cgiparams{sectionid} = $oldid; # reset
}

sub Cloud {
    my $oldid = $cgiparams{sectionid};
    $cgiparams{sectionid} = $SECTIONID;
    $cgiparams{actcode} = 'diary-meta';
    shift->SUPER::Cloud();
    $cgiparams{sectionid} = $oldid; # reset
}

sub Search {
    return  unless($cgiparams{data});

    my $oldid = $cgiparams{sectionid};
    $cgiparams{sectionid}          = $SECTIONID;
    $settings{data}{article_limit} = $settings{diary_limit};
    $settings{data}{article_stop}  = $settings{diary_stop};

    shift->SUPER::Search();
    _count_comments();
    $cgiparams{sectionid} = $oldid; # reset
}

sub Item {
    my $oldid = $cgiparams{sectionid};
    $cgiparams{sectionid} = $SECTIONID;
    shift->SUPER::Item();
    $tvars{diary} = $tvars{article};
    my @rows = $dbi->GetQuery('hash','GetDiaryComments',$tvars{diary}->{data}->{articleid});
    for(@rows) {
        $_->{postdate} = formatDate(6,$_->{createdate});
    }

    $tvars{comments} = \@rows;
    $cgiparams{sectionid} = $oldid; # reset
}

sub Comment {
    my $check = CheckIP();
    if(    $check == $BLOCK
        || $cgiparams{typekey}
        || !$cgiparams{loopback}
        || $cgiparams{loopback} ne $settings{ipaddr}) {

        $tvars{thanks} = 3;
#        print STDERR "COMMENT SPAM ALERT:\n" . Dumper(\%cgiparams);
        return;
    }

    $cgiparams{publish} = $check == $ALLOW ? 3 : 2;

    for(keys %cfields) {
        next    unless($cfields{$_});
           if($cfields{$_}->{html} == 1)    { $cgiparams{$_} = CleanHTML($cgiparams{$_}) }
        elsif($cfields{$_}->{html} == 2)    { $cgiparams{$_} = CleanTags($cgiparams{$_}) }
        elsif($cfields{$_}->{html} == 3)    { $cgiparams{$_} = CleanTags($cgiparams{$_}) }
    }

    return  if FieldCheck(\@callfields,\@cmandatory);

    if($tvars{data}->{subject} eq 'ARRAY(0x84fb748)') {
#        print STDERR "COMMENT SPAM ALERT:\n" . Dumper(\%cgiparams);
        $tvars{thanks} = 3;
        return;
    }

    my @fields = (  $tvars{data}->{articleid},
                    $tvars{data}->{subject},
                    formatDate(),               # create date
                    $tvars{data}->{body},
                    $tvars{data}->{author},
                    $tvars{data}->{href},
                    $tvars{data}->{publish},
                    $settings{ipaddr}
    );

    $dbi->IDQuery('AddComment',@fields);
    $tvars{thanks} = $check == $ALLOW ? 2 : 1;
}

sub LatestComments {
    my @rows = $dbi->GetQuery('hash','GetCommentsLatest');
    $tvars{latest}->{comments} = \@rows;
}

sub Posted {
    return    unless($cgiparams{'userid'});
    my @rows = $dbi->GetQuery('array','CountPosts',$cgiparams{'userid'});
    $tvars{data}{posts} = @rows ? $rows[0]->[0] : 0;
}

# -------------------------------------
# Admin Methods

=head1 ADMIN INTERFACE METHODS

=over 4

=item Access

=item Admin

=item Add

=item Edit

=item Save

=item Delete

=item ListComment

=item EditComment

=item SaveComment

=item MarkIP

=item PromoteComment

=item DeleteComment

=back

=cut

sub Access  { Authorised($LEVEL) }

sub Admin {
    return  unless AccessUser($LEVEL);
    $cgiparams{sectionid} = $SECTIONID;
    shift->SUPER::Admin();
}

sub Add {
    return  unless AccessUser($LEVEL);
    $cgiparams{sectionid} = $SECTIONID;
    my $self = shift;
    $self->SUPER::Add();
    $self->SUPER::Tags();
}

sub Edit {
    return  unless AccessUser($LEVEL);
    $cgiparams{sectionid} = $SECTIONID;

    my $self = shift;
    $self->SUPER::Edit();
    $self->SUPER::Tags();
    my @rows = $dbi->GetQuery('hash','GetDiaryComments',$tvars{article}->{data}->{articleid});
    for(@rows) {
        $_->{postdate} = formatDate(6,$_->{createdate});
    }

    $tvars{articles}->{$tvars{primary}}->{data}{comments} = scalar(@rows);
    $tvars{comments} = \@rows   if(@rows);
}

sub Save {
    return  unless AccessUser($LEVEL);
    $cgiparams{sectionid} = $SECTIONID;
    $cgiparams{quickname} = formatDate(0);
    shift->SUPER::Save();
}

sub Delete {
    return  unless AccessUser($LEVEL);
    $cgiparams{sectionid} = $SECTIONID;
    shift->SUPER::Delete();
}

sub ListComment {
    return  unless AccessUser($LEVEL);
    my @rows = $dbi->GetQuery('hash','GetAdminComments');
    for(@rows) {
        $_->{postdate} = formatDate(17,$_->{createdate});
    }

    $tvars{comments} = \@rows;
    $tvars{comcount} = scalar @rows;
}

sub EditComment {
    return  unless AuthorCheck('GetCommentByID','commentid',$LEVEL);
    $tvars{comment} = $tvars{data};
    $tvars{comment}->{postdate}  = formatDate(17,$tvars{comment}->{createdate});
    $tvars{comment}->{ddpublish} = PublishSelect($tvars{comment}->{publish});
}

sub SaveComment {
    return  unless AuthorCheck('GetCommentByID','commentid',$LEVEL);
    for(keys %cfields) {
        next    unless($cfields{$_});
           if($cfields{$_}->{html} == 1)    { $cgiparams{$_} = CleanHTML($cgiparams{$_}) }
        elsif($cfields{$_}->{html} == 2)    { $cgiparams{$_} = CleanTags($cgiparams{$_}) }
        elsif($cfields{$_}->{html} == 3)    { $cgiparams{$_} = CleanTags($cgiparams{$_}) }
    }

    return  if FieldCheck(\@callfields,\@cmandatory);
    $tvars{data}->{publish} ||= 1;

    my @fields = (  $tvars{data}->{subject},
                    $tvars{data}->{body},
                    $tvars{data}->{author},
                    $tvars{data}->{href},
                    $tvars{data}->{publish},
                    $tvars{data}->{commentid}
    );

    $dbi->IDQuery('SaveComment',@fields);
}

sub MarkIP {
    return  unless AuthorCheck('GetCommentByID','commentid',$LEVEL);
    return  unless $cgiparams{mark};
    my $mark = $cgiparams{mark} eq 'allow' ? 2 : 1;

    if($mark == 2)  { AllowIP($tvars{data}->{author},$tvars{data}->{ipaddr}) }
    else            { BlockIP($tvars{data}->{author},$tvars{data}->{ipaddr}) }

    my @rows = $dbi->GetQuery('hash','GetAdminCommentByIP',$tvars{data}->{ipaddr});
    for my $row (@rows) {
        next    unless($row->{ipaddr} eq $tvars{data}->{ipaddr});
        if($mark == 2) {
            $dbi->DoQuery('PromoteComment',$tvars{data}->{publish}+1,$row->{'commentid'});
        } else {
            $dbi->DoQuery('DeleteComment',$row->{'commentid'});
        }
    }
}

sub PromoteComment {
    return  unless AuthorCheck('GetCommentByID','commentid',$LEVEL);
    $dbi->DoQuery('PromoteComment',$tvars{data}->{publish}+1,$cgiparams{'commentid'});
}

sub DeleteComment {
    return  unless AuthorCheck('GetCommentByID','commentid',$LEVEL);
    $dbi->DoQuery('DeleteComment',$cgiparams{'commentid'});
}

# -------------------------------------
# Private Methods

sub _count_comments {
    my $type = shift || 'mainarts';
    return  unless($tvars{$type} && scalar(@{$tvars{$type}}));

    my $ids = join(',', map {$_->{data}{articleid}} @{$tvars{$type}});
    my @rows = $dbi->GetQuery('array','CountDiaryComments',{ids => $ids});
    my %rows = map {$_->[0] => $_->[1]} @rows;
    for my $item (@{$tvars{$type}}) {
        $item->{comments} = $rows{$item->{data}{articleid}} || 0;
    }
}

sub _vol2date {
    my ($year,$mon) = $_[0] =~ /^(\d{4})(\d{2})/;
    if($mon == 13) { $year++;$mon=1; }
    return timegm(0,0,0,1,$mon-1,$year);
}

1;

__END__

=head1 SEE ALSO

L<Labyrinth>

=head1 AUTHOR

Barbie, <barbie@missbarbell.co.uk> for
Miss Barbell Productions, L<http://www.missbarbell.co.uk/>

=head1 COPYRIGHT & LICENSE

  Copyright (C) 2002-2013 Barbie for Miss Barbell Productions
  All Rights Reserved.

  This module is free software; you can redistribute it and/or
  modify it under the Artistic License 2.0.

=cut