view release on metacpan or  search on metacpan

lib/App/SpamcupNG/UserAgent.pm  view on Meta::CPAN

package App::SpamcupNG::UserAgent;
use warnings;
use strict;
use Carp qw(confess);
use LWP::UserAgent 6.72;
use HTTP::Request 6.44;
use Log::Log4perl 1.57 qw(get_logger :levels);
use HTTP::CookieJar::LWP 0.014;
use Mozilla::PublicSuffix v1.0.6;
use HTTP::Request::Common 6.44 qw(POST);

our $VERSION = '0.020'; # VERSION

=head1 NAME

App::SpamcupNG::UserAgent - the SpamcupNG HTTP user agent

=head1 SYNOPSIS

=head1 DESCRIPTION

This class is responsible to interact with the Spamcop website, providing
requests and returning the HTML responses.

=head1 METHODS

=head2 new

Creates a new instance.

Expects as parameter:

- version: a string of the version of SpamcupNG.

Returns a new instance.

=cut

sub new {
    my ( $class, $version ) = @_;
    confess 'The parameter version is required' unless ($version);

    my $self = {
        name             => 'SpamcupNG user agent',
        version          => $version,
        members_url      => 'https://members.spamcop.net/',
        code_login_url   => 'https://www.spamcop.net/?code=',
        report_url       => 'https://www.spamcop.net/sc?id=',
        form_login_url   => 'https://www.spamcop.net/mcgi',
        domain           => 'https://www.spamcop.net/',
        password_field   => 'password',
        current_base_url => undef
    };

    bless $self, $class;

    my $ua = LWP::UserAgent->new(
        agent             => ( $self->{name} . '/' . $version ),
        protocols_allowed => ['https'],
        cookie_jar        => HTTP::CookieJar::LWP->new
    );

    # for form based authentication
    push @{ $ua->requests_redirectable }, 'POST';
    $self->{user_agent} = $ua;
    return $self;
}

=head2 user_agent

Returns a string with the HTTP header user-agent that will be used by the inner
HTTP user agent.

=cut

sub user_agent {
    my $self = shift;
    return $self->{user_agent}->agent;
}

=head2 login

Execute the login to Spamcop website.

If form based authentication is in use, it will login just once and return the
response of HTTP GET to Spamcop root URL.

Expect as parameters:

=over

=item *

id: the ID of a Spamcop account.

=item *

password: the password of a Spamcop account.

=back

Returns the HTTP response (HTML content) as a scalar reference.

=cut

# copied from HTTP::Request::as_string
sub _request_line {
    my $request  = shift;
    my $req_line = $request->method || "-";
    my $uri      = $request->uri;
    $uri = ( defined $uri ) ? $uri->as_string : "-";
    $req_line .= " $uri";
    my $proto = $request->protocol;
    $req_line .= " $proto" if $proto;
    return $req_line;
}

sub _redact_auth_req {
    my ( $self, $request ) = @_;
    my @lines;