The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#$Id: HTTPStatus.pm 2672 2008-08-15 15:28:00Z comdog $
package Test::HTTPStatus;
use strict;

use warnings;
no warnings;

=head1 NAME

Test::HTTPStatus - check an HTTP status

=head1 SYNOPSIS

	use Test::HTTPStatus tests => 2;
	use Apache::Constants qw(:http);

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

	http_ok( $url, $status );

=head1 DESCRIPTION

Check the HTTP status for a resource.

=cut

use 5.006;
use vars qw($VERSION);
$VERSION = 1.08;

use Carp qw(carp);
use HTTP::SimpleLinkChecker;
use Test::Builder;
use URI;

my $Test = Test::Builder->new;

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

=over 4

=item http_ok( URL [, HTTP_STATUS] )

Print the ok message if the URL's HTTP status matches the specified
HTTP_STATUS.  If you don't specify a status, it assumes you mean
HTTP_OK (from Apache::Constants).

=cut

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

	my $hash = _get_status( $url );

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

	if( defined $expected and $expected eq $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, "Mysterious failure for [$url]" );
		}
	}

sub _get_status
	{
	my $string = shift;

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

	my $url = URI->new($string)->canonical;
	return { result => INVALID_URL }
		unless UNIVERSAL::isa( $url, 'URI' );

	my $status = HTTP::SimpleLinkChecker::check_link( $url );

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

=back

=head1 SEE ALSO

Apache::Constants, HTTP::SimpleLinkChecker

=head1 SOURCE AVAILABILITY

This source is part of a SourceForge project which always has the
latest sources in CVS, as well as all of the previous releases.

	http://sourceforge.net/projects/brian-d-foy/

If, for some reason, I disappear from the world, one of the other
members of the project can shepherd this module appropriately.

=head1 AUTHOR

brian d foy, C<< <bdfoy@cpan.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2002-2007 brian d foy.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut


1;