File Coverage

blib/lib/HTML/Perlinfo/Apache.pm

Criterion	Covered	Total	%
statement	9	36	25.0
branch	0	14	0.0
condition	0	11	0.0
subroutine	3	8	37.5
pod	0	5	0.0
total	12	74	16.2

package HTML::Perlinfo::Apache;

use warnings;
use strict;
use HTML::Perlinfo::Common;



sub new {
    my %apache;
    my $env  = ( $ENV{SERVER_SOFTWARE} || "" ) =~ /apache/i;
    my $mp   = exists $ENV{MOD_PERL};
    $apache{'env'}  = $env;
    $apache{'mp'}   = $mp;
    bless \%apache;
}

sub has {
    my ( $self, @opts ) = @_;
		for my $opt (@opts) {
			return 0 unless $self->{$opt};
		}
    return 1;
}

sub print_apache {

	my $self = shift;
        my @mods;
	my  ($version, $hostname, $port, $mp_status) = ("Not detected") x 7;

	$mp_status = 'enabled' if $self->has(qw(mp));

	  ($version) = $ENV{'SERVER_SOFTWARE'} =~ /(\d+[\.\d]*)/
				if (defined $ENV{'SERVER_SOFTWARE'} && $ENV{'SERVER_SOFTWARE'} =~ /\d+[\.\d]*/);


	return join '', print_table_row(2, "Apache Version", "$version"),
                        (defined($ENV{'SERVER_NAME'}) && defined($ENV{'SERVER_PORT'})) ?
			print_table_row(2, "Hostname:Port", "$ENV{'SERVER_NAME'} : $ENV{'SERVER_PORT'}"):
			print_table_row(2, "Hostname:Port", "$hostname : $port"),
			print_table_row(2, "mod_perl", "$mp_status");
}

sub print_modperl {

	my ($version_status, $version_number) = ("Not detected") x 3;

	  $version_status = '1.0';
          $version_status = '2.0 or higher' if $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2;
          ($version_number) = $ENV{MOD_PERL} =~ /^\S+\/(\d+(?:[\.\_]\d+)+)/;
	  $version_number =~ s/_//g;
          $version_number =~ s/(\.[^.]+)\./$1/g;
	  unless ($version_status eq '2.0 or higher') {
	    if ( $version_number >= 1.9901 ) {
                 $version_status = '1.9 which is incompatible with 2.0';
            }
	  }

	 return join '', print_box_start(0),
		"Running under mod_perl version $version_status (version number: $version_number)",
			 print_box_end();

}

sub print_apache_environment {


	return join '', print_table_row(2, "DOCUMENT_ROOT", $ENV{'DOCUMENT_ROOT'}),
			print_table_row(2, "HTTP_ACCEPT", $ENV{'HTTP_ACCEPT'}),
			print_table_row(2, "HTTP_ACCEPT_CHARSET", $ENV{'HTTP_ACCEPT_CHARSET'}),
			print_table_row(2, "HTTP_ACCEPT_ENCODING", $ENV{'HTTP_ACCEPT_ENCODING'}),
			print_table_row(2, "HTTP_ACCEPT_LANGUAGE", $ENV{'HTTP_ACCEPT_LANGUAGE'}),
			print_table_row(2, "HTTP_CONNECTION", $ENV{'HTTP_CONNECTION'}),
			print_table_row(2, "HTTP_HOSTS", $ENV{'HTTP_HOSTS'}),
			print_table_row(2, "HTTP_KEEP_ALIVE", $ENV{'HTTP_KEEP_ALIVE'}),
			print_table_row(2, "HTTP_USER_AGENT", $ENV{'HTTP_USER_AGENT'}),
			print_table_row(2, "PATH", $ENV{'PATH'}),
			print_table_row(2, "REMOTE_ADDR", $ENV{'REMOTE_ADDR'}),
			print_table_row(2, "REMOTE_HOST", $ENV{'REMOTE_HOST'}),
			print_table_row(2, "REMOTE_PORT", $ENV{'REMOTE_PORT'}),
			print_table_row(2, "SCRIPT_FILENAME", $ENV{'SCRIPT_FILENAME'}),
			print_table_row(2, "SCRIPT_URI", $ENV{'SCRIPT_URI'}),
			print_table_row(2, "SCRIPT_URL", $ENV{'SCRIPT_URL'}),
			print_table_row(2, "SERVER_ADDR", $ENV{'SERVER_ADDR'}),
			print_table_row(2, "SERVER_ADMIN", $ENV{'SERVER_ADMIN'}),
			print_table_row(2, "SERVER_NAME", $ENV{'SERVER_NAME'}),
			print_table_row(2, "SERVER_PORT", $ENV{'SERVER_PORT'}),
			print_table_row(2, "SERVER_SIGNATURE", $ENV{'SERVER_SIGNATURE'}),
			print_table_row(2, "SERVER_SOFTWARE", $ENV{'SERVER_SOFTWARE'}),
			print_table_row(2, "GATEWAY_INTERFACE", $ENV{'GATEWAY_INTERFACE'}),
			print_table_row(2, "SERVER_PROTOCOL", $ENV{'SERVER_PROTOCOL'}),
			print_table_row(2, "REQUEST_METHOD", $ENV{'REQUEST_METHOD'}),
			print_table_row(2, "QUERY_STRING", $ENV{'QUERY_STRING'}),
			print_table_row(2, "REQUEST_URI", $ENV{'REQUEST_URI'}),
			print_table_row(2, "SCRIPT_NAME", $ENV{'SCRIPT_NAME'});

}
1;