File Coverage

blib/lib/Test/HTTPStatus.pm

Criterion	Covered	Total	%
statement	52	81	64.2
branch	0	20	0.0
condition	0	14	0.0
subroutine	14	18	77.7
pod	2	2	100.0
total	68	135	50.3

package Test::HTTPStatus;

use strict;
use warnings;

=encoding utf-8

=head1 NAME

Test::HTTPStatus - check an HTTP status

=head1 SYNOPSIS

	use Test::HTTPStatus tests => 2;

	http_ok('https://www.perl.org', HTTP_OK);

	http_ok($url, $status);

=head1 DESCRIPTION

Check the HTTP status for a resource.

=cut

use v5.10.1;	# Mojolicious is v5.10.1 and later
our $VERSION = '2.12';

use parent 'Test::Builder::Module';

use Carp qw(carp);
# use HTTP::SimpleLinkChecker;
use Mojo::UserAgent;
use Test::Builder::Module;
use Mojo::URL;

my $Test = __PACKAGE__->builder;

use constant NO_URL             =>  -1;
use constant INVALID_URL        =>  -2;
use constant HTTP_OK            => 200;
use constant HTTP_NOT_FOUND     => 404;

sub import {
	my $self = shift;
	my $caller = caller;
	no strict 'refs';
	*{$caller.'::http_ok'}         = \&http_ok;
	*{$caller.'::NO_URL'}          = \&NO_URL;
	*{$caller.'::INVALID_URL'}     = \&INVALID_URL;
	*{$caller.'::HTTP_OK'}         = \&HTTP_OK;
	*{$caller.'::HTTP_NOT_FOUND'}  = \&HTTP_NOT_FOUND;

	$Test->exported_to($caller);
	$Test->plan(@_);
}

=head1 FUNCTIONS

=head2 http_ok( URL [, HTTP_STATUS ] )

    http_ok( $url, $expected_status );

Tests the HTTP status of the specified URL and reports whether it matches the expected status.

=head3 Parameters

=over 4

=item * C (Required)

The URL to be tested.
This must be a valid URL string.
If the URL is invalid or undefined, the test will fail, and an appropriate diagnostic message will be displayed.

=item * C (Optional)

The expected HTTP status code.
Defaults to C (200) if not provided.
This parameter should be one of the HTTP status constants exported by the module (e.g., C, C).

=back

=head3 Diagnostics

On success, the test will pass with a message in the following format:

    Expected [], got [] for []

On failure, the test will fail with one of the following messages:

=over 4

=item * C<[$url] does not appear to be anything>

Indicates that the URL was undefined or missing.

=item * C<[$url] does not appear to be a valid URL>

Indicates that the URL string provided was invalid or malformed.

=item * C

Indicates that the request failed for an unexpected reason or returned a status not matching the expected value.

=back

=head3 Examples

=over 4

=item * Basic test with default expected status:

    http_ok('https://www.perl.org');

This checks that the URL C returns an HTTP status of C (200).

=item * Test with a custom expected status:

    http_ok('https://www.example.com/404', HTTP_NOT_FOUND);

This checks that the URL C returns an HTTP status of C (404).

=back

=head3 Return Value

The routine does not return any value.
Instead, it reports success or failure using the underlying test builder's C method.

=cut

sub http_ok {
	my $url = shift;
	my $expected = shift || HTTP_OK;

	# Always succeed when NO_NETWORK_TESTING is set
	my $hash = $ENV{'NO_NETWORK_TESTING'} ? { status => $expected, url => $url } : _get_status( $url );

	my $status = $hash->{status};

	if(!defined($status)) {
		$Test->ok(0, "[$url] status is not set");
	} elsif(defined($expected) && ($expected == $status)) {
		$Test->ok(1, "Expected [$expected], got [$status] for [$url]");
	} elsif($status == NO_URL) {
		$Test->ok( 0, "[$url] does not appear to be anything" );
	} elsif( $status == INVALID_URL ) {
		$Test->ok( 0, "[$url] does not appear to be a valid URL" );
	} else {
		$Test->ok(0, "Unknown failure for [$url] with status [$status]");
	}
}

sub _get_status {
	my $string = shift;

	return { status => NO_URL } unless defined $string;

	my $url = Mojo::URL->new( $string );
	return { status => INVALID_URL } unless $url->host();

	my $status = _check_link( $url );

	return { url => $url, status => $status };
}

=head2 _check_link

Verify the accessibility of a given URL by checking its HTTP status code using L.
It first attempts to send a HEAD request to the provided link,
which is useful for quickly checking if the resource exists without downloading its content.
If the response indicates no error (i.e., status code is below 400),
the function proceeds with a GET request to ensure a proper response is received.
The function then validates whether a valid HTTP response was obtained and returns the corresponding status code.
If the link is undefined or if no valid response is received, the function returns C.

It is taken from the old module HTTP::SimpleLinkChecker.

=cut

our $UA ||= Mojo::UserAgent->new();
$UA->proxy->detect();
$UA->max_redirects(3);

sub _check_link {
	my $link = shift;

	say STDERR "Link is $link";
	unless( defined $link ) {
		# $ERROR = 'Received no argument';
		return;
	}

	my $transaction = $UA->head($link);
	my $response = $transaction->res();

	if(!$response || !defined($response->code()) || (($response->code() >= 400) && ($response->code() != 404))) {
		$transaction = $UA->get($link);
		$response = $transaction->res();
	}

	unless(ref($response)) {
		# $ERROR = 'Could not get response';
		return;
	}

	return $response->code();
}

=head2 user_agent

Returns the user agent being used

=cut

sub user_agent { $UA }

=head1 SEE ALSO

L, L

=head1 AUTHORS

brian d foy, C<<  >>

Maintained by Nigel Horne, C<<  >>

=head1 SUPPORT

This module is provided as-is without any warranty.

You can find documentation for this module with the perldoc command.

    perldoc Test::HTTPStatus

You can also look for information at:

=over 4

=item * MetaCPAN

L

=item * RT: CPAN's request tracker

L

=item * CPANTS

L

=item * CPAN Testers' Matrix

L

=item * CPAN Testers Dependencies

L

=back

=head1 LICENSE AND COPYRIGHT

This program is released under the following licence: GPL2
Copyright © 2002-2019, brian d foy . All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the terms of the Artistic License 2.0.

=cut

1;