File Coverage

blib/lib/Test/HTTPStatus.pm
Criterion Covered Total %
statement 67 70 95.7
branch 5 10 50.0
condition 2 5 40.0
subroutine 17 17 100.0
pod 1 1 100.0
total 92 103 89.3


line stmt bran cond sub pod time code
1             package Test::HTTPStatus;
2 3     3   118212 use strict;
  3         16  
  3         79  
3              
4 3     3   15 use warnings;
  3         5  
  3         89  
5 3     3   13 no warnings;
  3         4  
  3         97  
6              
7             =encoding utf8
8              
9             =head1 NAME
10              
11             Test::HTTPStatus - check an HTTP status
12              
13             =head1 SYNOPSIS
14              
15             use Test::HTTPStatus tests => 2;
16             use Apache::Constants qw(:http);
17              
18             http_ok( 'https://www.perl.org', HTTP_OK );
19              
20             http_ok( $url, $status );
21              
22             =head1 DESCRIPTION
23              
24             THIS IS AN ABANDONED MODULE. THERE IS NO SUPPORT. YOU CAN ADOPT IT
25             IF YOU LIKE: https://pause.perl.org/pause/query?ACTION=pause_04about#takeover
26              
27             Check the HTTP status for a resource.
28              
29             =cut
30              
31 3     3   33 use v5.10.1; # Mojolicious is v5.10.1 and later
  3         9  
32             our $VERSION = '2.004';
33              
34 3     3   1160 use parent 'Test::Builder::Module';
  3         808  
  3         15  
35              
36 3     3   175 use Carp qw(carp);
  3         6  
  3         141  
37 3     3   1090 use HTTP::SimpleLinkChecker;
  3         1250460  
  3         184  
38 3     3   39 use Test::Builder::Module;
  3         7  
  3         37  
39 3     3   82 use Mojo::URL;
  3         5  
  3         17  
40              
41             my $Test = __PACKAGE__->builder;
42              
43 3     3   136 use constant NO_URL => -1;
  3         7  
  3         232  
44 3     3   15 use constant INVALID_URL => -2;
  3         5  
  3         113  
45 3     3   16 use constant HTTP_OK => 200;
  3         7  
  3         127  
46 3     3   15 use constant HTTP_NOT_FOUND => 404;
  3         18  
  3         288  
47              
48             sub import {
49 3     3   20 my $self = shift;
50 3         7 my $caller = caller;
51 3     3   23 no strict 'refs';
  3         5  
  3         1078  
52 3         8 *{$caller.'::http_ok'} = \&http_ok;
  3         18  
53 3         6 *{$caller.'::NO_URL'} = \&NO_URL;
  3         21  
54 3         6 *{$caller.'::INVALID_URL'} = \&INVALID_URL;
  3         12  
55 3         7 *{$caller.'::HTTP_OK'} = \&HTTP_OK;
  3         9  
56 3         6 *{$caller.'::HTTP_NOT_FOUND'} = \&HTTP_NOT_FOUND;
  3         10  
57              
58 3         17 $Test->exported_to($caller);
59 3         38 $Test->plan(@_);
60             }
61              
62             =head1 FUNCTIONS
63              
64             =over 4
65              
66             =item http_ok( URL [, HTTP_STATUS] )
67              
68             Print the ok message if the URL's HTTP status matches the specified
69             HTTP_STATUS. If you don't specify a status, it assumes you mean
70             HTTP_OK (from Apache::Constants).
71              
72             =cut
73              
74             sub http_ok {
75 1     1 1 88 my $url = shift;
76 1   50     4 my $expected = shift || HTTP_OK;
77              
78 1         4 my $hash = _get_status( $url );
79              
80 1         3 my $status = $hash->{status};
81              
82 1 50 33     9 if( defined $expected and $expected eq $status ) {
    0          
    0          
83 1         11 $Test->ok( 1, "Expected [$expected], got [$status] for [$url]" );
84             }
85             elsif( $status == NO_URL ) {
86 0         0 $Test->ok( 0, "[$url] does not appear to be anything" );
87             }
88             elsif( $status == INVALID_URL ) {
89 0         0 $Test->ok( 0, "[$url] does not appear to be a valid URL" );
90             }
91             else {
92 0         0 $Test->ok( 0, "Mysterious failure for [$url] with status [$status]" );
93             }
94             }
95              
96             sub _get_status {
97 5     5   161663 my $string = shift;
98              
99 5 100       27 return { status => NO_URL } unless defined $string;
100              
101 4         42 my $url = Mojo::URL->new( $string );
102 4 100       683 return { status => undef } unless $url->host;
103              
104 3         24 my $status = HTTP::SimpleLinkChecker::check_link( $url );
105              
106 3         608620 return { url => $url, status => $status };
107             }
108              
109             =back
110              
111             =head1 SEE ALSO
112              
113             Apache::Constants, HTTP::SimpleLinkChecker
114              
115             =head1 SOURCE AVAILABILITY
116              
117             This project is in GitHub:
118              
119             https://github.com/CPAN-Adoptable-Modules/test-httpstatus
120              
121             =head1 AUTHOR
122              
123             brian d foy, C<< >>
124              
125             =head1 COPYRIGHT AND LICENSE
126              
127             Copyright © 2002-2019, brian d foy . All rights reserved.
128              
129             This program is free software; you can redistribute it and/or modify
130             it under the terms of the Artistic License 2.0.
131              
132             =cut
133              
134              
135             1;