view release on metacpan or  search on metacpan

lib/App/MonM/Checkit/HTTP.pm  view on Meta::CPAN

See C<LICENSE> file and L<https://dev.perl.org/licenses/>

=cut

use vars qw/$VERSION/;
$VERSION = '1.01';

use Encode;
use CTK::ConfGenUtil;
use URI;
use LWP::UserAgent();
use HTTP::Request();

use App::MonM::Const qw/PROJECTNAME/;
use App::MonM::Util qw/set2attr getTimeOffset/;

use constant {
        DEFAULT_URL     => "http://localhost",
        DEFAULT_METHOD  => "GET",
        DEFAULT_TIMEOUT => 180,
    };

sub check {
    my $self = shift;
    my $type = $self->type;
    return $self->maybe::next::method() unless $type && ($type eq 'http' or $type eq 'https');

    # Init
    my $url = lvalue($self->config, 'url') || DEFAULT_URL;
    my $method = lvalue($self->config, 'method') || DEFAULT_METHOD;
    my $timeout = getTimeOffset(lvalue($self->config, 'timeout') || DEFAULT_TIMEOUT);
    my $attr = set2attr($self->config);
    my $content = lvalue($self->config, 'content') // '';
    my $proxy = lvalue($self->config, 'proxy') || "";

    # Agent
    my $uri = URI->new($url);
    my $ua = LWP::UserAgent->new(
        agent               => sprintf("%s/%s", PROJECTNAME, $VERSION),
        timeout             => $timeout,
        protocols_allowed   => ['http', 'https'],
    );
    $ua->default_header($_, value($attr, $_)) for (keys %$attr);

    # Proxy
    $ua->proxy(['http', 'https'], $proxy) if $proxy;

    # Prepare request data
    my $request = HTTP::Request->new(uc($method) => $uri);
    if ($method =~ /PUT|POST|PATCH/) {
        Encode::_utf8_on($content);
        $request->header('Content-Length' => length(Encode::encode("utf8", $content)));
        $request->content(Encode::encode("utf8", $content));
    }

    # Request
    my $response = $ua->request($request);

    # Result
    $self->status(($response->is_info || $response->is_success || $response->is_redirect) ? 1 : 0);
    $self->error($response->decoded_content // '') unless $self->status;
    $self->source(sprintf("%s %s", $method, $response->request->uri->canonical->as_string));
    $self->message($response->status_line || '');
    $self->code($response->code || 0);
    $self->content($response->decoded_content // '');

    return;
}

1;

__END__