# 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: Akismet.pm 3327 2008-09-15 09:45:10Z josh $

package BigMed::Akismet;
use strict;
use warnings;
use utf8;
use Carp;
$Carp::Verbose = 1;

use BigMed;
use BigMed::Log;
use HTTP::Request::Common;

my $PERL_5_8 = ( $] >= 5.008 ); #determines utf-8 handling
my $TIMEOUT         = 6;
my $AKISMET_VERSION = '1.1';

sub new {
    my $class = shift;
    my %param = @_;

    my $bm = BigMed->bigmed;
    my $key = $param{key} || $bm->env('AKISMET_KEY');
    return if !$key || !$param{url};      #not enough info to get started

    my $user_agent = BigMed->bigmed->user_agent( { timeout => $TIMEOUT } )
      or return;
    $user_agent->default_headers->push_header( 'Content-Type' =>
          'application/x-www-form-urlencoded; charset=utf-8' );
    my $self = {
        ua  => $user_agent,
        key => $key,
        url => $param{url},
    };
    bless $self, $class;
    return $self->_verify_key ? $self : ();
}

sub check {
    my $self = shift;
    my $response = $self->_submit( 'comment-check', {@_} ) or return;
    if ( $response eq 'true' ) {
        $self->log( info => 'Akismet: Comment bad, identified as spam' );
        return 'spam';
    }
    elsif ( $response eq 'false' ) {
        $self->log( info => 'Akismet: Comment ok, identified as ham' );
        return 'ok';
    }
    $self->log( warning =>
          "Akismet: Unexpected response to comment-check: $response" );
    return;
}

sub spam {
    my $self = shift;
    return $self->_submit( 'submit-spam', {@_} );
}

sub ham {
    my $self = shift;
    return $self->_submit( 'submit-ham', {@_} );
}

sub _verify_key {
    my $self     = shift;
    my $url      = $self->_akismet_url('verify-key');
    my $response = $self->{ua}->request(
        POST $url,
        [   key  => $self->{key},
            blog => $self->{url},
        ]
    );
    if ( !$response ) {
        $self->log(
            warning => 'Akismet: No response from server on key validation' );
        return;
    }
    if ( !$response->is_success() ) {
        my $status = $response->status_line;
        $self->log( warning => "Akismet: Error on key validation: $status" );
        return;
    }
    if ( !$response->content() eq 'valid' ) {
        $self->log( warning => 'Akismet: Invalid key' );
        return;
    }
    return 1;
}

sub _akismet_url {
    my ( $self, $action, $key ) = @_;
    $key ||= q{};
    $key &&= "$key.";
    return "http://${key}rest.akismet.com/$AKISMET_VERSION/$action";
}

sub _submit {
    my $self   = shift;
    my $action = shift || 'comment-check';
    my $rparam = shift;
    return if !$rparam->{user_ip};    #required parameter

    #convert utf-encoded strings into bytes
    my %param = %{$rparam};
    foreach my $k ( keys %param ) {
        $param{$k} = $PERL_5_8
          ? _utf8_to_bytes_perl58( $param{$k} )
          : _utf8_to_bytes_perl56( $param{$k} );
    }

    $self->log( info => "Akismet: Submitting $action for comment by "
          . $param{comment_author} );

    my $url = $self->_akismet_url( $action, $self->{key} );
    my $response = $self->{ua}->request(
        POST $url,
        [   blog                 => $self->{url},
            user_ip              => $param{user_ip},
            user_agent           => $self->{ua}->agent(),
            referrer             => $param{referrer},
            permalink            => $param{permalink},
            comment_type         => $param{comment_type},
            comment_author       => $param{comment_author},
            comment_author_email => $param{comment_author_email},
            comment_author_url   => $param{comment_author_url},
            comment_content      => $param{comment_content},
        ]
    );

    if ( !$response ) {
        $self->log(
            warning => "Akismet: No response from server for $action" );
        return;
    }
    if ( !$response->is_success() ) {
        my $status = $response->status_line;
        $self->log( warning => "Akismet: Error for $action: $status" );
        return;
    }

    #assign to var to avoid warning
    my $content = $response->content()
      or $self->log( warning => "Akismet: Empty response to $action" );

    #mark as unicode
    $content = $PERL_5_8
      ? _bytes_to_utf8_perl58($content)
      : _bytes_to_utf8_perl56($content);

    return $content;
}

# UTF8 HELPERS FOR MODERN PERL (5.8+) ----------------------------
sub _utf8_to_bytes_perl58 {
    local $SIG{'__DIE__'};
    require Encode;
    return Encode::encode( 'utf8', $_[0] );
}

sub _bytes_to_utf8_perl58 {
    local $SIG{'__DIE__'};
    require Encode;
    return Encode::decode( 'utf8', $_[0] );

}

# UTF8 HELPERS FOR ELDER PERL (5.6) ----------------------------
sub _utf8_to_bytes_perl56 {
    return pack "C*", unpack "U0C*", $_[0];
}

sub _bytes_to_utf8_perl56 {
    return pack "U0C*", unpack "C*", $_[0];
}

1;

__END__