Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Script to check links #111

Closed
wants to merge 6 commits into from
Closed
Show file tree
Hide file tree
Changes from 5 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
110 changes: 110 additions & 0 deletions bin/check_links
Original file line number Diff line number Diff line change
@@ -0,0 +1,110 @@
#!/usr/bin/perl
use v5.36;
briandfoy marked this conversation as resolved.
Show resolved Hide resolved
use strict;
use warnings;

=head1 NAME

bin/check_links - verify the links in the perlfaq

=head1 SYNOPSIS

# check all the links in
perl bin/check_links

# check a single perlfaq page, just specify the number
perl bin/check_links 3

# check a range with the min and max
perl bin/check_links 3 6

# see all the errors at the end
perl bin/check_links | sort

=head1 DESCRIPTION

This program extracts the links from all the perlfaq pages then tries
to fetch them. It reports the HTTP status, the perlfaq page, and the
link. In the case of a redirect response, it also reports the Location
value.

Note that redirections sometimes leads to more redirections, which this
does not handle. Sometimes those chains lead to dead links, or even
cycles.

If the program cannot connect to a server, it reports a 500
status. This does not mean the link is bad since this could be a local
network hiccup.

If there are any bad links (permanent redirects, or any 4xx or 5xx
statuses), this program exits with a non-zero value. If no links are
bad, it exits with 0.

=head1 AUTHOR

brian d foy, [email protected]

=head1 LICENSE

You can use and distribute this under the same terms as perl. A LICENSE
file is included with the perlfaq repository.

=cut

use File::Spec::Functions;
use Mojo::Promise;
use Mojo::UserAgent;
use Mojo::Util qw(dumper);

@ARGV = ( 1, 9 ) unless @ARGV;
my( $min, $max ) = @ARGV;
$max //= $min;

my $ua = Mojo::UserAgent->new;
$ua->inactivity_timeout(10);

my $Checked = {};

sub print_status ( $code, $section, $link, $redirect = undef ) {
printf "%3d %8s %s%s\n", $code, $section, $link,
defined $redirect ? ' -> ' . $redirect : '';
;
}

my @promises =
map {
my $t = $_;

my $success = sub ($tx) {
$Checked->{$t->{link}}{code} = $tx->res->code;
$Checked->{$t->{link}}{count}++;
$Checked->{$t->{link}}{location} = $tx->res->headers->location;
print_status( $tx->res->code, $t->{section}, $t->{link}, $tx->res->headers->location )
};

my $error = sub ($err) {
$Checked->{$t->{link}}{code} = 500;
$Checked->{$t->{link}}{count}++;
print_status( 500, $t->{section}, $t->{link}, undef )
};

my $promise = $ua->get_p( $t->{link} )->then(
$success,
$error,
);
}
map {
my $section = "perlfaq$_";
my $path = catfile( 'lib', "$section.pod" );
my $contents = Mojo::File->new( $path )->slurp;
my @links = $contents =~ m|L<(?:[^>]+?\|)?(https?://.+?)>|ig;
map { { section => $section, path => $path, link => $_ } } @links;
}
$min .. $max;

my $all = Mojo::Promise->all_settled( @promises );
$all->wait;

my $Errors = () = grep { $_->{code} =~ m/30[18]|[45]\d\d/ } values $Checked->%*;

exit( $Errors ? 1 : 0 );
28 changes: 14 additions & 14 deletions lib/perlfaq1.pod
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@ The core development team (known as the Perl Porters)
are a group of highly altruistic individuals committed to
producing better software for free than you could hope to purchase for
money. You may snoop on pending developments via the
L<archives|http://www.nntp.perl.org/group/perl.perl5.porters/>
L<archives|https://www.nntp.perl.org/group/perl.perl5.porters/>
or you can subscribe to the mailing list by sending
[email protected] a subscription request
(an empty message with no subject is fine).
Expand Down Expand Up @@ -114,7 +114,7 @@ minor release (i.e. perl5.25.x, where 25 is the minor release).

=item *

You can consult L<releases|http://dev.perl.org/perl5> to determine the
You can consult L<releases|https://dev.perl.org/perl5/> to determine the
current stable release of Perl.

=back
Expand Down Expand Up @@ -177,21 +177,21 @@ backward compatibility.
Recently, the plan has been to release a new version of Perl roughly every
April, but getting the release right is more important than sticking rigidly to
a calendar date, so the release date is somewhat flexible. The historical
release dates can be viewed at L<http://www.cpan.org/src/README.html>.
release dates can be viewed at L<https://www.cpan.org/src/README.html>.

Even numbered minor versions (5.14, 5.16, 5.18) are production versions, and
odd numbered minor versions (5.15, 5.17, 5.19) are development versions. Unless
you want to try out an experimental feature, you probably never want to install
a development version of Perl.

The Perl development team are called Perl 5 Porters, and their
organization is described at L<http://perldoc.perl.org/perlpolicy.html>.
organization is described at L<https://perldoc.perl.org/perlpolicy>.
The organizational rules really just boil down to one: Larry is always
right, even when he was wrong.

=head2 Is Perl difficult to learn?

No, Perl is easy to start L<learning|http://learn.perl.org/> --and easy to keep learning. It looks
No, Perl is easy to start L<learning|https://learn.perl.org/> --and easy to keep learning. It looks
like most programming languages you're likely to have experience
with, so if you've ever written a C program, an awk script, a shell
script, or even a BASIC program, you're already partway there.
Expand All @@ -213,7 +213,7 @@ of programming experience, an understanding of regular expressions, and
the ability to understand other people's code. If there's something you
need to do, then it's probably already been done, and a working example is
usually available for free. Don't forget Perl modules, either.
They're discussed in Part 3 of this FAQ, along with L<CPAN|http://www.cpan.org/>, which is
They're discussed in Part 3 of this FAQ, along with L<CPAN|https://www.cpan.org/>, which is
discussed in Part 2.

=head2 How does Perl compare with other languages like Java, Python, REXX, Scheme, or Tcl?
Expand All @@ -224,12 +224,12 @@ be used well or badly. Perl has many strengths, and a few weaknesses,
precisely which areas are good and bad is often a personal choice.

When choosing a language you should also be influenced by the
L<resources|http://www.cpan.org/>, L<testing culture|http://www.cpantesters.org/>
and L<community|http://www.perl.org/community.html> which surrounds it.
L<resources|https://www.cpan.org/>, L<testing culture|http://www.cpantesters.org/>
and L<community|https://www.perl.org/community.html> which surrounds it.

For comparisons to a specific language it is often best to create
a small project in both languages and compare the results, make sure
to use all the L<resources|http://www.cpan.org/> of each language,
to use all the L<resources|https://www.cpan.org/> of each language,
as a language is far more than just it's syntax.

=head2 Can I do [task] in Perl?
Expand Down Expand Up @@ -292,7 +292,7 @@ programs to produce the same output, spinning things quickly out of
control while still providing hours of amusement for their creators and
readers.

CPAN has several JAPH programs at L<http://www.cpan.org/misc/japh>.
CPAN has several JAPH programs at L<https://www.cpan.org/misc/japh>.

=head2 How can I convince others to use Perl?

Expand All @@ -312,8 +312,8 @@ choice and how Perl might satisfy that requirement.

You don't have to worry about finding or paying for Perl; it's freely
available and several popular operating systems come with Perl. Community
support in places such as Perlmonks ( L<http://www.perlmonks.com> )
and the various Perl mailing lists ( L<http://lists.perl.org> ) means that
support in places such as Perlmonks ( L<https://www.perlmonks.com> )
and the various Perl mailing lists ( L<https://lists.perl.org> ) means that
you can usually get quick answers to your problems.

Finally, keep in mind that Perl might not be the right tool for every
Expand All @@ -326,9 +326,9 @@ You might find these links useful:

=over 4

=item * L<http://www.perl.org/about.html>
=item * L<https://www.perl.org/about.html>

=item * L<http://perltraining.com.au/whyperl.html>
=item * L<https://stackoverflow.blog/2022/07/06/why-perl-is-still-relevant-in-2022/>

=back

Expand Down
Loading