File Coverage

blib/lib/Net/Defensio.pm

Criterion	Covered	Total	%
statement	87	104	83.6
branch	21	36	58.3
condition	21	50	42.0
subroutine	10	15	66.6
pod	8	13	61.5
total	147	218	67.4

package Net::Defensio;

# TODO: XML format support, YAML::Syck support

use strict;
use Net::Defensio::Response;

our $VERSION = '0.02';
our $ERROR;
our $API_VERSION = '1.1';

my $UA = "Perl-Net-Defensio/$VERSION";

our $REQUEST_PARAMS = {
    'validate-key' => { required => [ qw( owner-url ) ] },
    'announce-article' => { required => [ qw( owner-url article-author
        article-author-email article-title article-content permalink ) ] },
    'audit-comment' => { required => [ qw( owner-url user-ip
        article-date comment-author comment-author-email
        comment-type ) ],
        optional => [ qw( comment-content
        comment-author-url permalink referrer user-logged-in
        trusted-user test-force ) ] },
    'report-false-negatives' => { required => [ qw( owner-url
        signatures ) ] },
    'report-false-positives' => { required => [ qw( owner-url
        signatures ) ] },
    'get-stats' => { required => [ qw( owner-url ) ] },
};
our $RESPONSE_PARAMS = {
    'validate-key' => [ qw( status message api-version ) ],
    'announce-article' => [ qw( status message api-version ) ],
    'audit-comment' => [ qw( status message api-version signature
        spam spaminess ) ],
    'report-false-negatives' => [ qw( status message api-version ) ],
    'report-false-positives' => [ qw( status message api-version ) ],
    'get-stats' => [ qw( status message api-version accuracy spam ham
        false-positives false-negatives learning learning-message ) ],
};

sub new {
    my $pkg = shift;
    $pkg = ref $pkg if ref $pkg;

    my (%param) = @_;

    return $pkg->error("Required parameter missing: 'api_key'")
        unless $param{api_key};

    my $obj = { api_key => $param{api_key} };
    $obj->{user_agent} = delete $param{user_agent};
    $obj->{agent} = delete $param{agent} || $UA;
    $obj->{api_version} = delete $param{api_version} || $API_VERSION;
    $obj->{host} = delete $param{host} || 'api.defensio.com';
    $obj->{format} = delete $param{format} || 'yaml';
    $obj->{service_type} = delete $param{service_type} || 'app';
    $obj->{protocol} = delete $param{protocol} || 'http';
    $obj->{port} = delete $param{port} || 80;

    return bless $obj, $pkg;
}

sub user_agent {
    my $obj = shift;
    $obj->{user_agent} = shift if @_;
    return $obj->{user_agent} if $obj->{user_agent};
    require LWP::UserAgent;
    return $obj->{user_agent} = LWP::UserAgent->new;
}

sub service_url {
    my $obj = shift;
    my (%param) = @_;

    my $action = $param{action}
        or return $obj->error("'action' parameter required");

    my $protocol = $param{protocol} || $obj->{protocol};
    my $host = $param{host} || $obj->{host};
    my $port = $param{port} || $obj->{port};
    if (($port ne '') && ($port != 80)) {
        $port = ':' . $port;
    } else {
        $port = '';
    }
    my $service_type = $param{service_type} || $obj->{service_type};
    my $api_version = $param{api_version} || $obj->{api_version};
    my $api_key = $param{api_key} || $obj->{api_key};
    my $format = $param{format} || $obj->{format};

    my $url = join "/", "$protocol:/", "$host$port",
        $service_type, $api_version, $action, "$api_key.$format";

    return $url;
}

sub safe_submit {
    my $obj = shift;
    my ($action, $param) = @_;

    return $obj->error("Invalid request for unknown '$action'")
        unless exists $REQUEST_PARAMS->{$action};

    my $req_params = $REQUEST_PARAMS->{$action}{required} || [];
    my $opt_params = $REQUEST_PARAMS->{$action}{optional} || [];
    my %req_param;
    my @params;

    foreach my $p (@$req_params) {
        (my $under_p = $p) =~ s/-/_/g;
        my $val;
        foreach ($p, $under_p, lc($under_p)) {
            $val = $param->{$_}, last if exists $param->{$_};
        }
        return $obj->error("Required parameter missing: '$p'")
            unless defined $val;
        push @params, $p, $val if defined $val;
    }
    foreach my $p (@$opt_params) {
        (my $under_p = $p) =~ s/-/_/g;
        my $val;
        foreach ($p, $under_p, lc($under_p)) {
            $val = $param->{$_}, last if exists $param->{$_};
        }
        push @params, $p, $val if defined $val;
    }

    my $service_url = $param->{'service-url'} || $param->{service_url} ||
        $obj->service_url( action => $action, %$param );

    my $response = $obj->user_agent->post( $service_url, \@params );

    if ($response && !$response->is_success()) {
        return $obj->error("Error with $action request: "
            . $response->status_line);
    }
    elsif (!$response) {
        return $obj->error("Error with $action request");
    }

    $obj->process_http_response($action, $response);
}

sub process_http_response {
    my $obj = shift;
    my ($action, $http_resp) = @_;

    my $content = $http_resp->content();
    my $result = {};
    if ($content =~ m/^\s*<\?xml/) {
        # process as xml!
    }
    else {
        # process as yaml!
        require YAML::Tiny;
        my $y = YAML::Tiny->read_string($content);
        my $doc = $y->[0];
        my $resp_params = $RESPONSE_PARAMS->{$action};
        foreach my $p (@$resp_params) {
            my $val = $doc->{'defensio-result'}{$p};
            $p =~ s/-/_/g;
            if (defined $val) {
                $result->{$p} = $val;
            }
        }
    }
    $result->{action} = $action;
    return Net::Defensio::Response->new($result);
}

# API methods

sub validate_key {
    my $obj = shift;
    my (%param) = @_;
    $obj->safe_submit('validate-key', \%param);
}

sub announce_article {
    my $obj = shift;
    my (%param) = @_;
    $obj->safe_submit('announce-article', \%param);
}

sub audit_comment {
    my $obj = shift;
    my (%param) = @_;
    $obj->safe_submit('audit-comment', \%param);
}

sub report_false_negatives {
    my $obj = shift;
    my (%param) = @_;
    $obj->safe_submit('report-false-negatives', \%param);
}

sub report_false_positives {
    my $obj = shift;
    my (%param) = @_;
    $obj->safe_submit('report-false-positives', \%param);
}

sub get_stats {
    my $obj = shift;
    my (%param) = @_;
    $obj->safe_submit('get-stats', \%param);
}

# Error API

sub errstr {
    my $pkg = shift;
    return ref($pkg) ? $pkg->{error} : $ERROR;
}

sub error {
    my $pkg = shift;
    (ref($pkg) ? $pkg->{error} : $ERROR) = shift;
    return undef;
}

1;
__END__