The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict;
use warnings;

=encoding utf8

=head1 NAME

http_status - check the HTTP status of a URL

=head1 SYNOPSIS

	% http_status URL [URL ...]

=head1 DESCRIPTION

http_status gets the HTTP status of a URL as returned by the
server. It actually works with more than HTTP links since it
uses the C<LWP> Perl module which treats all URLs the same.
This works too:

	% perl script/http_status file:///Users/brian/.login

If you have C<Term::ANSIColor>, it will color the output. If
you have C<HTML::SimpleLinkExtor>, it will parse the HTML of
the resource and then check all of those links.

=head1 SOURCE AVAILABILITY

This source is in Github:

	http://github.com/briandfoy/http-simplelinkchecker

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<< <bdfoy@cpan.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright © 2007-2016, brian d foy <bdfoy@cpan.org>. All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

use HTTP::SimpleLinkChecker qw(check_link);
use HTTP::Status;

foreach my $url ( @ARGV ) {
	my $status = check_link( $url );

	print_line( $url, $status );
	next unless is_success( $status );

	check_links( $url );
	}

BEGIN {

my %colors = (
	is_success     => 'green',
	is_error       => 'red',
	is_redirect    => 'yellow',
	is_bad_request => 'cyan',
	);

sub print_line {
	my( $url, $status ) = @_;

	foreach my $sub_name ( keys %colors ) {
		no strict 'refs';
		next unless &{ $sub_name }( $status );
		print color( $colors{ $sub_name } );
		}

	print "$url ... $status\n";

	print color( 'reset' );
	}

}

sub is_bad_request
	{
	my $status = shift;

	return $status == 400;
	}

BEGIN { # load optional modules, set stubs otherwise
eval "use HTML::SimpleLinkExtor";
*check_links = do {
	if( $@ ) {
		sub { 0 }
		}
	else {
		my $extor = HTML::SimpleLinkExtor->new;

		sub {
			my $url = shift;

			my %seen = ();
			$extor->parse_url( $url );

			foreach my $link ( $extor->absolute_links )
				{
				next if $seen{$link}++;
				my $status = check_link( $link );
				print_line( "\t$link", $status );
				}

			$extor->clear_links
			}

		}
	};

eval "use Term::ANSIColor qw(color)";
if( $@ ) { *color = sub { '' } };
}

# these ensure that the color is reset at exit
BEGIN { $SIG{'INT'} = sub { exit } }
END { print color( 'reset' ) }