#$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<< >> =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;