# Copyright 2002-2008 Josh Clark and Global Moxie, LLC. This code cannot be
# redistributed without permission from globalmoxie.com.  For more
# information, consult your Big Medium license.
#
# $Id: Comment.pm 3281 2008-08-25 22:46:12Z josh $

package BigMed::Comment;
use strict;
use warnings;
use utf8;
use Carp;
$Carp::Verbose = 1;
use base qw(BigMed::MiniContent);
use BigMed;
use BigMed::Filter;
use BigMed::User;
use BigMed::DiskUtil qw(bm_file_path bm_write_file bm_delete_file);
use HTML::Template;
use BigMed::Akismet;

BigMed::Comment->add_trigger( 'comment_submitted', \&_akismet_status );
BigMed::Comment->add_trigger( 'comment_mark_spam', \&_akismet_to_spam );
BigMed::Comment->add_trigger( 'comment_approved',  \&_akismet_to_ham );

###########################################################
# SET COMMENT DATA SCHEMA
###########################################################

my @data_schema = (
    {   name  => 'page',
        type  => 'id',
        index => 1,
    },
    {   name    => 'status',
        type    => 'value_list',
        options => [qw(ok mod spam)],
        labels  => {
            'ok'   => 'MODERATE_status_ok',
            'spam' => 'MODERATE_status_spam',
            'mod'  => 'MODERATE_status_mod',
        },
        index => 1,
    },
    {   name  => 'post_time',
        type  => 'system_time',
        index => 1,
    },
    {   name  => 'commenter',
        type  => 'simple_text',
        index => 1,
    },
    {   name  => 'email',
        type  => 'email',
        index => 1,
    },
    {   name => 'content',
        type => 'rich_text_public',
    },
    {   name => 'url',
        type => 'url',
    },
    {   name => 'ip',
        type => 'raw_text',
    },
);

BigMed::Comment->register_minicontent( elements => \@data_schema, );

my %PREFS = (
    'html_comments_enabled' => {
        default     => '',
        edit_type   => 'boolean',
        edit_params =>
          { option_label => 'PREFS_OPTION_html_comments_enabled', },
        priority => 100,
        sitewide => 1,
    },
    'html_comments_mod' => {
        default     => '',
        edit_type   => 'boolean',
        edit_params => { option_label => 'PREFS_OPTION_html_comments_mod', },
        priority    => 98,
        sitewide    => 1,
    },
    'html_comments_akismet' => {
        default     => '1',
        edit_type   => 'boolean',
        edit_params => {
            option_label    => 'PREFS_OPTION_akismet_enabled',
            container_class => 'bmcpDividerField'
        },
        priority => 96,
        sitewide => 1,
    },
    'html_comments_errmod' => {
        default     => '1',
        edit_type   => 'boolean',
        edit_params => { option_label => 'PREFS_OPTION_akismet_errmod' },
        priority    => 94,
        sitewide    => 1,
    },
    'html_commentcount_number' => {
        default     => '<%number%> comment(s)',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 92,
        edit_params => {
            description => 'PREFS_DESC_html_commentcount_number',
            required    => 1,
            container_class => 'bmcpDividerField'
        },
    },
    'html_comments_heading' => {
        default     => 'Comments',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 88,
        edit_params => {
            container_class => 'bmcpDividerField',
            description     => 'BM_rich_text_inline_notice',
            required        => 1,
        },
    },
    'html_comments_number' => {
        default     => '<%number%> comment(s) on this page.',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 86,
        edit_params => {
            description => 'PREFS_DESC_html_comments_number',
            required    => 1,
        },
    },
    'html_comments_link' => {
        default     => 'Add your own comment below.',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 84,
        edit_params => {
            description => 'BM_rich_text_inline_notice',
            required    => 1,
        },
    },
    'html_comments_disabled' => {
        default     => 'Comments on this page are closed.',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 82,
        edit_params => { description => 'BM_rich_text_inline_notice', },
    },
    'html_comments_form_heading' => {
        default     => 'Add a Comment',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 78,
        edit_params => {
            container_class => 'bmcpDividerField',
            description     => 'BM_rich_text_inline_notice',
            required        => 1,
        },
    },
    'html_comments_form_caption' => {
        default     => 'Please be civil.',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 76,
        edit_params => {
            description => 'BM_rich_text_inline_notice',
        },
    },
    'html_comments_name' => {
        default     => 'Your name',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 75,
        edit_params => {
            description => 'BM_rich_text_inline_notice',
            required    => 1,
        },
    },
    'html_comments_email' => {
        default     => 'Your e-mail',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 74,
        edit_params => {
            description => 'BM_rich_text_inline_notice',
            required    => 1,
        },
    },
    'html_comments_url' => {
        default     => 'Your website',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 73,
        edit_params => {
            description => 'BM_rich_text_inline_notice',
            required    => 1,
        },
    },
    'html_comments_comment' => {
        default     => 'Your comment',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 72,
        edit_params => {
            description => 'BM_rich_text_inline_notice',
            required    => 1,
        },
    },
    'html_comments_format' => {
        default     => 'Use Markdown for formatting.',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 71,
        edit_params => {
            description => 'BM_rich_text_inline_notice',
        },
    },
    'html_comments_remember' => {
        default     => 'Remember me',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 70,
        edit_params => {
            description => 'BM_rich_text_inline_notice',
            required    => 1,
        },
    },
    'html_comments_submit' => {
        default     => 'Submit',
        edit_type   => 'simple_text',
        sitewide    => 1,
        priority    => 60,
        edit_params => { required => 1, },
    },
    'html_comments_preview' => {
        default     => 'Preview',
        edit_type   => 'simple_text',
        sitewide    => 1,
        priority    => 50,
        edit_params => { required => 1, },
    },
    'html_comments_modtitle' => {
        default     => 'Thanks for Your Comment',
        edit_type   => 'rich_text_inline',
        sitewide    => 1,
        priority    => 40,
        edit_params => {
            container_class => 'bmcpDividerField',
            description     => 'BM_rich_text_inline_notice',
            required        => 1,
        },
    },
    'html_comments_modtext' => {
        default =>
          'RichText:<p>Thanks for contributing! As an anti-spam measure, '
          . 'we have to review your comment before adding it to the '
          . 'site. We will do this as soon as possible; thanks for your '
          . 'patience.</p><p>Click to return to the original page:</p>',
        edit_type   => 'rich_text_brief',
        sitewide    => 1,
        priority    => 35,
        edit_params => {
            description => 'BM_rich_text_inline_notice',
            required    => 1,
        },
    },
);

sub comment_prefs {
    return %PREFS;
}

sub register_comment_prefs {
    return if BigMed::Prefs->pref_exists('html_comments_heading');
    foreach my $pref_name ( keys %PREFS ) {
        BigMed::Prefs->register_pref( $pref_name, $PREFS{$pref_name} );
    }
    if ( !BigMed::Prefs->pref_exists('html_links_window') ) {    #ugly
        BigMed::Prefs->register_pref(
            'html_links_window',
            {   edit_type => 'boolean',
                default   => 0,
                sitewide  => 1,
            }
        );
        BigMed::Prefs->register_pref(
            'html_links_window_intdomains',
            {   edit_type => 'value_freeform',
                default   => [],
                sitewide  => 1,
            }
        );
    }
    return;
}

sub build_page_comments {
    my ( $self, $site, $page ) = @_;
    croak 'build_page_comments requires site object'
      if !$site->isa('BigMed::Site');
    croak 'build_page_comments requires page object'
      if !$page->isa('BigMed::Content::Page');
    register_comment_prefs();

    #gather comments
    my $comments =
      BigMed::Comment->select(
        { site => $page->site, page  => $page->id, status => 'ok' },
        { sort => 'post_time', order => 'ascend' } )
      or return;
    my $c;
    my @comments;
    my $i = 0;
    while ( $c = $comments->next ) {
        $i++;
        push @comments, $c->prep_tmpl_params($site, $i);
    }

    #create and load the template object
    my $mdata = BigMed->bigmed->env('MOXIEDATA');
    my $tpath = [
        bm_file_path( $mdata, 'templates_custom', 'site_templates', 'HTML' ),
        bm_file_path( $mdata, 'templates',        'site_templates', 'HTML' ),
    ];
    my $tmpl = HTML::Template->new(
        filename          => 'wi_comments_include.tmpl',
        path              => $tpath,
        die_on_bad_params => 0,
        cache             => 1,
        loop_context_vars => 1
    );

    my $tally = $site->get_pref_value('html_comments_number');
    my $count = scalar @comments;
    $tally =~ s/&lt;%number%&gt;/$count/msig;
    $tmpl->param(
        heading  => $site->get_pref_value('html_comments_heading'),
        tally    => $tally,
        linktext => $site->get_pref_value('html_comments_link'),
        comments => \@comments,
    );
    my $html = $tmpl->output;

    #handle new-window links
    if ( $site->get_pref_value( 'html_links_window' ) ) {
        $html =~ s{(<a([^>]+)href\s*=\s*"([^"]+)"([^>]*)>)}{
            _update_new_win_tag($site, $3,$1,$2,$4);
          }msge;
    }
    
    #write comment include file
    my $file = $self->comment_file_path( $site, $page );
    bm_write_file( $file, $html, { build_path => 1 } ) or return;
    
    #build tally link file
    my $tally_html;
    my $cc_tally = $site->get_pref_value('html_commentcount_number');
    $cc_tally =~ s/&lt;%number%&gt;/$count/msig;
    $cc_tally =~ s/ /&nbsp;/msig;
    my $url = $page->active_page_url( $site ) . '#bmcomments';
    $tmpl = HTML::Template->new(
        filename          => 'wi_commentcount.tmpl',
        path              => $tpath,
        die_on_bad_params => 0,
        cache             => 1,
        loop_context_vars => 1
    );
    $tmpl->param(
        tally    => $cc_tally,
        url      => $url,
    );
    $tally_html = $tmpl->output;
    $file = $self->tally_file_path( $site, $page );
    bm_write_file( $file, $tally_html, { build_path => 1 } )
      or return;

    return 1;
}

#should probably abstract this new-window code into a separate module;
#using pretty identical code in Format::HTML, Comment, and Web::WebSearch

my $NEW_WIN = ' target="newsite"';

sub _update_new_win_tag {
    my ( $site, $url, $tag, $int1, $int2 ) = @_;
    return $tag if !_is_new_window_url( $site, $url );
    foreach ( $int1, $int2 ) {
        return $tag if /target\s*=\s*"/i;
    }
    $tag =~ s/(href\s*=\s*"\Q$url\E")/$1$NEW_WIN/;
    return $tag;
}
    
sub _is_new_window_url {
    my ( $site, $url ) = @_;
    return 0 if index( $url, 'http' ) != 0;
    foreach my $dom ( $site->get_pref_value('html_links_window_intdomains') ) {
        return 0 if index( $url, $dom ) == 0;
    }
    return 1;
}

sub comment_file_path {
    my ( $self, $site, $page ) = @_;
    my $pid = ref $page ? $page->id : $page;
    return bm_file_path( $site->html_dir, 'bm.comments', "$pid.txt" );
}

sub tally_file_path {
    my ( $self, $site, $page ) = @_;
    my $pid = ref $page ? $page->id : $page;
    return bm_file_path( $site->html_dir, 'bm.comments', "$pid-tally.txt" );
}

sub trash_comment_file {
    my ( $self, $site, $page ) = @_;
    bm_delete_file( $self->comment_file_path( $site, $page ) ) or return;
    bm_delete_file( $self->tally_file_path( $site, $page ) ) or return;
    return 1;
}

my %SITE_USERS;

sub is_staff {
    my $comment = shift;
    my $sid     = $comment->site;
    my $remail  = ( $SITE_USERS{$sid} ||= {} );
    my $e       = $comment->email
      or return undef; #specifically use undef so we don't throw off params
    return $remail->{$e} if exists $remail->{$e};

    my $select = BigMed::User->select( { email => $e } ) or return;
    my $u;
    while ( $u = $select->next ) {
        $remail->{$e} = 1, last if $u->privilege_level($sid);
    }
    return $remail->{$e};
}

sub safe_content {
    return BigMed::Filter->sanitize(
        BigMed::Filter->filter( $_[0]->content ) );
}

sub prep_tmpl_params {
    my ( $comment, $site, $index ) = @_;
    my $app  = BigMed->bigmed->app;
    my $date = $app->format_time(
        $comment->post_time,
        {   dformat      => $site->date_format,
            no_time      => 1,
            not_relative => 1,
            site         => $site,
        }
    );
    my $time = $app->format_time(
        $comment->post_time,
        {   dformat      => ( $site->time_format || '%r' ),
            no_time      => 1,
            not_relative => 1,
            site         => $site,
        }
    );

    my $id = $comment->id || '0';
    return {
        'name'    => $comment->commenter,
        'url'     => $comment->url,
        'date'    => $date,
        'time'    => $time,
        'comment' => $comment->safe_content,
        'id'      => "bmc$id",
        'staff'   => $comment->is_staff,
        'number'  => ($index || '#'),
        'ip'      => $comment->ip,
    };
}

sub _akismet_status {
    my ( $comment, $site ) = @_;
    register_comment_prefs();
    return 1 if !$site->get_pref_value('html_comments_akismet');

    my $url          = $site->homepage_url . '/';
    my $ak           = BigMed::Akismet->new( url => $url );
    my $mod_on_error = $site->get_pref_value('html_comments_errmod');
    if ( !$ak ) {    #error validating key
        $comment->set_status('mod') if $mod_on_error;
        return 1;
    }

    #prep data
    my $page =
      BigMed::Content::Page->fetch(
        { site => $site->id, id => $comment->page } );
    my $permalink = $page ? $page->active_page_url($site) : q{};
    ( my $content = $comment->content ) =~ s/^Markdown://;
    my $author = BigMed::App::Web->unescape( $comment->commenter );

    #get status (spam or ok)
    my $status = $ak->check(
        blog     => $url,
        referrer => $ENV{HTTP_REFERER},
        $comment->_akismet_params($site),
    );
    if ( !$status ) {    #error getting status
        $comment->set_status('mod') if $mod_on_error;
        return 1;
    }
    $comment->set_status($status);
    return 1;
}

sub _akismet_to_spam {
    my ( $comment, $site ) = @_;
    return 1 if $comment->status ne 'ok';

    register_comment_prefs();
    return 1 if !$site->get_pref_value('html_comments_akismet');

    my $url = $site->homepage_url . '/';
    my $ak = BigMed::Akismet->new( url => $url ) or return 1;
    $ak->spam(
        blog => $url,
        $comment->_akismet_params($site),
    );
    return 1;
}

sub _akismet_to_ham {
    my ( $comment, $site ) = @_;
    return 1 if $comment->status ne 'spam';

    register_comment_prefs();
    return 1 if !$site->get_pref_value('html_comments_akismet');

    my $url = $site->homepage_url . '/';
    my $ak = BigMed::Akismet->new( url => $url ) or return 1;
    $ak->ham(
        blog => $url,
        $comment->_akismet_params($site),
    );
    return 1;
}

sub _akismet_params {
    my ( $comment, $site ) = @_;
    my $page =
      BigMed::Content::Page->fetch(
        { site => $site->id, id => $comment->page } );
    my $permalink = $page ? $page->active_page_url($site) : q{};
    ( my $content = $comment->content ) =~ s/^Markdown://;
    my $author = $comment->commenter;
    $author =~ s/&amp;/&/g;
    $author =~ s/&gt;/>/g;
    $author =~ s/&lt;/</g;
    return (
        user_ip              => $comment->ip,
        comment_type         => 'comment',
        comment_author       => $author,
        comment_author_email => $comment->email,
        comment_author_url   => $comment->url,
        comment_content      => $content,
        permalink            => $permalink,
    );
}

1;

__END__

=head1 NAME

BigMed::Comment - Big Medium comment object

=head1 DESCRIPTION

A BigMed::Comment object represents a single comment for one page.

=head1 USAGE

BigMed::Comment is a subclass of BigMed::Data. In addition to the methods 
documented below, please see the BigMed::Data documentation for details about
topics including:

=over 4

=item Creating a new data object

=item Saving a data object

=item Finding and sorting saved data objects

=item Data access methods

=item Error handling

=back

=head1 METHODS

=head2 Data Access Methods

BigMed::Comment objects hold the following pieces of data. They can be
accessed and set using the standard data access methods described in the
BigMed::Data documentation. See the L<"Searching and Sorting"> section below
for details on the data columns available to search and sort BigMed::Site
objects.

=over 4

=item * id

The numeric ID of the tag object

=item * site

The numeric ID of the site to which the object belongs

=item * page

The numeric ID of the page to which the object belongs

=item * post_time

The time at which the comment was submitted

=item * status

One of three values: 'ok', 'mod', 'spam'

=item * commenter

The name of the commenter

=item * content

The comment text, in rich-text format: 'Markdown:text goes here.' The
recommended way to get at the final, sanitized HTML is to use the
C<safe_content> method.

=item * email

E-mail address of the commenter

=item * url

Web URL of the commenter

=item * ip

IP address from which the comment was submitted

=item * mod_time

Timestamp for when the last time the object was saved.

=item * create_time

Timestamp for when the object was first created.

=back

=head3 C<< $comment->is_staff >>

Returns true if the commenter's email address matches the address of one
or more user accounts with privileges at the site.

=head3 Searching and Sorting

You can look up and sort records by any combination of the following fields.
See the C<fetch> and C<select> documentation in BigMed::Data for more info.

=over 4

=item * id

=item * site

=item * page

=item * post_time

=item * commenter

=item * email

=item * status

=item * mod_time

=back

=head2 HTML/Template Methods

==head3 C<< $self->safe_content() >>

Returns the sanitized HTML to display on the public site.

==head3 C<< $self->build_page_comments($site_obj, $page_obj) >>

Builds the page's comment file and comment tally file in the bm.comments
directory of each of the page's html sections. Returns true on success,
false on error (and puts a message in the error queue).

=head3 C<< $obj->prep_tmpl_params($site_obj, $index) >>

Returns a hash reference of HTML::Template parameters, suitable to be
passed to the Big Medium "wi_comment_guts.tmpl" site HTML template or
"wi_comment_preview.tmpl" control panel template.

The index value in the second argument is the number of the item in the
comment list. If not included, the value "#" is used.

=head3 C<< $self->comment_file_path($site_obj, $page_id_or_obj) >>

Returns the absolute file path of the comment include file for the
page in the second argument.

=head3 C<< $self->trash_comment_file($site_obj, $page_id_or_obj) >>

Deletes the comment include file for the page in the second argument.
Returns true on success, false on error (adding a message to the
error queue).

=head2 Preference Methods

The module handles the Big Medium installation's comment
preferences and allows external code to request this preference
definition so that it can register the preferences when needed.
(BigMed::Format::HTML uses this to register the preferences as
HTML preferences, for example.)

=head3 C<< $self->comment_prefs >>

Returns a hash of preference definitions, which may be registered like so:

    use BigMed::Prefs;
    my %pref = BigMed::Comment->comment_prefs;
    foreach my $name ( keys %pref ) {
        BigMed::Prefs->register_pref( $name, $pref{$name} );
    }

=head3 C<< $self->register_comment_prefs >>

Registers the comment preferences.

=head2 Callbacks

BigMed::Comment has three callback hooks in addition to the usual
BigMed::Data hooks. You can register call backs using the C<add_trigger>
method:

    BigMed::Comment->add_trigger( 'comment_submitted', \&callback );

All callbacks receive the comment object and the site object as arguments.
The available hooks for registering callbacks are:

=over 4

=item * comment_submitted

=item * comment_mark_spam

=item * comment_approved

=back

=head1 SEE ALSO

=over 4

=item * BigMed::Data

=item * BigMed::Content::Page

=back

=head1 AUTHOR & COPYRIGHTS

This module and all Big Medium modules are copyright Josh Clark
and Global Moxie. All rights reserved.

Use of this module and the Big Medium content
management system are governed by Global Moxie's software licenses
and may not be used outside of the terms and conditions outlined
there.

For more information, visit the Global Moxie website at
L<http://globalmoxie.com/>.

Big Medium and Global Moxie are service marks of Global Moxie
and Josh Clark. All rights reserved.

=cut