line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package HTTP::SimpleLinkChecker; |
2
|
5
|
|
|
5
|
|
171547
|
use v5.10.1; # Mojolicious requires this |
|
5
|
|
|
|
|
31
|
|
3
|
5
|
|
|
5
|
|
25
|
use strict; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
108
|
|
4
|
|
|
|
|
|
|
|
5
|
5
|
|
|
5
|
|
19
|
use warnings; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
123
|
|
6
|
5
|
|
|
5
|
|
21
|
no warnings; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
150
|
|
7
|
|
|
|
|
|
|
|
8
|
5
|
|
|
5
|
|
19
|
use Exporter qw(import); |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
190
|
|
9
|
|
|
|
|
|
|
|
10
|
5
|
|
|
5
|
|
30
|
use vars qw($ERROR); |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
272
|
|
11
|
|
|
|
|
|
|
|
12
|
5
|
|
|
5
|
|
2490
|
use Mojo::UserAgent; |
|
5
|
|
|
|
|
1910440
|
|
|
5
|
|
|
|
|
48
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our @EXPORT_OK = qw(check_link); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
my $UA = Mojo::UserAgent->new(); |
17
|
|
|
|
|
|
|
$UA->proxy->detect; |
18
|
|
|
|
|
|
|
$UA->max_redirects(3); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $VERSION = '1.168'; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub check_link { |
23
|
3
|
|
|
3
|
1
|
3615
|
my( $link ) = @_; |
24
|
3
|
|
|
|
|
144
|
say STDERR "Link is $link"; |
25
|
3
|
50
|
|
|
|
19
|
unless( defined $link ) { |
26
|
0
|
|
|
|
|
0
|
$ERROR = 'Received no argument'; |
27
|
0
|
|
|
|
|
0
|
return; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
3
|
|
|
|
|
18
|
my $transaction = $UA->head($link); |
31
|
3
|
|
|
|
|
839365
|
my $response = $transaction->res; |
32
|
|
|
|
|
|
|
|
33
|
3
|
50
|
33
|
|
|
27
|
if( ! $response and $response->code >= 400 ) { |
34
|
0
|
|
|
|
|
0
|
$transaction = $UA->get($link); |
35
|
0
|
|
|
|
|
0
|
$response = $transaction->res; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
3
|
50
|
|
|
|
12
|
unless( ref $response ) { |
39
|
0
|
|
|
|
|
0
|
$ERROR = 'Could not get response'; |
40
|
0
|
|
|
|
|
0
|
return; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
3
|
|
|
|
|
11
|
return $response->code; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
2
|
|
|
2
|
1
|
895
|
sub user_agent { $UA } |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
1; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=encoding utf8 |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 NAME |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
HTTP::SimpleLinkChecker - Check the HTTP response code for a link |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head1 SYNOPSIS |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
THIS MODULE HAS BEEN ABANDONED. YOU CAN ADOPT IT |
59
|
|
|
|
|
|
|
https://pause.perl.org/pause/authenquery?ACTION=pause_04about#takeover |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
use HTTP::SimpleLinkChecker; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
my $code = HTTP::SimpleLinkChecker::check_link($url); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
unless( defined $code ) { |
66
|
|
|
|
|
|
|
print "Error: $HTTP::SimpleLinkChecker::ERROR\n"; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 DESCRIPTION |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
You don't have to know anything about objected-oriented Perl, LWP, or |
72
|
|
|
|
|
|
|
the HTTP module to be able to check your links. This module is |
73
|
|
|
|
|
|
|
designed for the casual user. It has one function, C, that |
74
|
|
|
|
|
|
|
returns the HTTP response code that it receives when it tries to fetch |
75
|
|
|
|
|
|
|
the web address passed to it. The undef value is returned for any |
76
|
|
|
|
|
|
|
non-HTTP failure and the C<$HTTP::SimpleLinkChecker::ERROR> variable |
77
|
|
|
|
|
|
|
is set. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
The HEAD method is tried first, although if anything other than a good |
80
|
|
|
|
|
|
|
status code (those less than 400) is received, another request is made |
81
|
|
|
|
|
|
|
with the GET method. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
The user-agent will automatically handle redirects. If you don't like |
84
|
|
|
|
|
|
|
that, you can change the user agent settings before you start: |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
HTTP::SimpleLinkChecker::user_agent()->max_redirects(0); |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
The user agent is L, so anything you do with that |
89
|
|
|
|
|
|
|
module you can do with the user agent. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Note that even with the best code, no module can control how |
92
|
|
|
|
|
|
|
servers decide to respond to a check, or control any of the myriad |
93
|
|
|
|
|
|
|
things that can go wrong with the network between you and the remote |
94
|
|
|
|
|
|
|
server. Some may filter requests based on origin IP address, |
95
|
|
|
|
|
|
|
user-agent type, or any other arbitrary factor. Some servers may not |
96
|
|
|
|
|
|
|
respond correctly at all. Furthermore, some servers might be |
97
|
|
|
|
|
|
|
temporarily down or overloaded. I recommend that you recheck "broken" |
98
|
|
|
|
|
|
|
links a couple times over a long period (like a day or two) before you |
99
|
|
|
|
|
|
|
decide they are really broken. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
If you are behind a firewall or proxy, this module picks up those |
102
|
|
|
|
|
|
|
settings through L's C method. See |
103
|
|
|
|
|
|
|
L for more details. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head2 Functions |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=over 4 |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=item check_link( URL ) |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Returns the HTTP response code for URL. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=item user_agent |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Returns a reference to the Mojo::UserAgent object. You |
116
|
|
|
|
|
|
|
can affect it directly. See L. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
my $ua = HTTP::SimpleLinkChecker::user_agent(); |
119
|
|
|
|
|
|
|
$ua->transactor->name( 'Mozilla 19.2' ); |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=back |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=head1 SOURCE AVAILABILITY |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
This source is in Github: |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
https://github.com/briandfoy/http-simplelinkchecker |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=head1 AUTHOR |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
brian d foy, C<< >> |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head2 Contributors |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=over 4 |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=item * Sebastian Paaske Tørholm, C<< >> |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=back |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
Copyright © 2004-2021, brian d foy . All rights reserved. |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
146
|
|
|
|
|
|
|
it under the Artistic License 2.0. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=cut |