#!/usr/bin/perl
use strict;
use warnings;

=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 part of a SourceForge project which always has the
latest sources in SVN, as well as all of the previous releases.

	http://sourceforge.net/projects/brian-d-foy/

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 (c) 2007 brian d foy. 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' ) }