#! /usr/bin/perl
# site_tester tests sites, and is released
# under the terms of the GPL version 2, or any later version, at your
# option. See the file README and COPYING for more information.
# Copyright 2009 by Don Armstrong <don@donarmstrong.com>.
# $Id: perl_script 1432 2009-04-21 02:42:41Z don $


use warnings;
use strict;

use Getopt::Long;
use Pod::Usage;

=head1 NAME

site_tester - Test sites

=head1 SYNOPSIS

 [options]

 Options:
  --debug, -d debugging level (Default 0)
  --help, -h display this help
  --man, -m display manual

=head1 OPTIONS

=over

=item B<--debug, -d>

Debug verbosity. (Default 0)

=item B<--help, -h>

Display brief usage information.

=item B<--man, -m>

Display this manual.

=back

=head1 EXAMPLES


=cut


use vars qw($DEBUG);

use IO::File;
use WWW::Mechanize;

my %options = (debug           => 0,
	       help            => 0,
	       man             => 0,
	       ip_addr         => '127.0.0.1',
	       apache_conf     => '/etc/apache2/sites-enabled/*',
	       );

GetOptions(\%options,
	   'debug|d+','help|h|?','man|m',
	   'ip_addr|ip-addr=s',
	   'apache_conf|apache-conf=s',
	  );

pod2usage() if $options{help};
pod2usage({verbose=>2}) if $options{man};

$DEBUG = $options{debug};

my @USAGE_ERRORS;
# if (1) {
#      push @USAGE_ERRORS,"You must pass something";
# }

pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;

my @conf_files = glob($options{apache_conf});

my %sites;

{package SITE_TESTER::http;
 use warnings;
 use strict;
 use LWP::Protocol::http;
 require LWP::MemberMixin;
 use base qw(LWP::Protocol::http);
 sub _new_socket{
     my($self, $host, $port, $timeout) = @_;
     $host = $self->{ua}{____special_host};
     return $self->SUPER::_new_socket($host,$port,$timeout);
 }
 sub socket_class {
     return "LWP::Protocol::http::Socket";
 }
}

# parse the conf_files

for my $conf_file (@conf_files) {
    next unless -r $conf_file;
    my $fh = IO::File->new($conf_file,'r');
    while (<$fh>) {
	chomp;
	next unless /^\s*ServerName\s(\S+)/;
	$sites{$1} = 1;
    }
}

my $mech = WWW::Mechanize->new(autocheck => 0);
$mech->{____special_host} = $options{ip_addr};
LWP::Protocol::implementor('http','SITE_TESTER::http');

for my $site (sort keys %sites) {
    $mech->get("http://$site/");
    print "site $site [$options{ip_addr}]: ".$mech->status()."\n";
    # print $mech->content();
    # for my $header ($mech->response->header_field_names) {
    # 	print $header.': '.$mech->response->header($header)."\n";
    # }
}

__END__