The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use strict;
use warnings;

use LWP::UserAgent;
use URI::URL;
use HTML::LinkExtor;
use English qw( -no_match_vars );
use Carp;
use IO::Handle;
use Fatal qw(open close);

my $fh;
open $fh, q{<}, 'lib/Test/Weaken.pm';
LINE: while ( my $line = <$fh> ) {
    if ($line =~ m{
            ([\$*])
            (
                ([\w\:\']*)
                \b
                VERSION
            ) \b .* \=
            }xms
        )
    {
        {

            package Test::Weaken;
            ## no critic (BuiltinFunctions::ProhibitStringyEval)
            my $retval = eval $line;
            ## use critic
            if ( not defined $retval ) {
                Carp::croak("eval of $line failed");
            }
            last LINE;
        }
    } ## end if ( $line =~ /             /xms )
} ## end while ( my $line = <$fh> )
close $fh;

my $cpan_base = 'http://search.cpan.org';
my $doc_base =
      $cpan_base
    . '/~jkegl/Test-Weaken-'
    . $Test::Weaken::VERSION
    . '/lib/Test/';

print "Starting at $doc_base\n"
    or Carp::croak("Cannot print: $ERRNO");

my @url = qw(
    Weaken.pm
);

my %link;

sub cb {
    my ( $tag, %links ) = @_;
    return unless $tag eq 'a';
    my $href = $links{href};
    return if $href =~ /^[#]/xms;
    return ( $link{$href} = 1 );
}

my %link_ok;

$OUTPUT_AUTOFLUSH = 1;

PAGE: for my $url (@url) {
    $url = $doc_base . $url;

    my $p  = HTML::LinkExtor->new( \&cb );
    my $ua = LWP::UserAgent->new;

    %link = ();

    # Request document and parse it as it arrives
    my $request_response = $ua->request( HTTP::Request->new( GET => $url ),
        sub { $p->parse( $_[0] ) } );

    my $page_response_status_line = $request_response->status_line;
    if ( $request_response->code != 200 ) {
        print 'PAGE: ', $page_response_status_line, q{ }, $url, "\n"
            or Carp::croak("Cannot print: $ERRNO");
        next PAGE;
    }

    LINK: for my $link ( keys %link ) {

        $link = 'http://search.cpan.org' . $link
            if $link =~ m{^/}xms;

        next LINK if $link_ok{$link};

        my $response = $ua->request( HTTP::Request->new( GET => $link ) );

        if ( $response->code == 200 ) {
            $link_ok{$link} = 1;
            print q{.}
                or Carp::croak("Cannot print: $ERRNO");
            next LINK;
        }

        print 'LINK: ', $response->status_line, q{ }, $link, "\n"
            or Carp::croak("Cannot print: $ERRNO");

    }

    print " PAGE: $page_response_status_line: $url\n"
        or Carp::croak("Cannot print: $ERRNO");

}