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


line stmt bran cond sub pod time code
1             package HTML::Perlinfo::Apache;
2            
3 1     1   6 use warnings;
  1         2  
  1         31  
4 1     1   5 use strict;
  1         2  
  1         19  
5 1     1   480 use HTML::Perlinfo::Common;
  1         2  
  1         1025  
6            
7            
8            
9             sub new {
10 0     0 0   my %apache;
11 0   0       my $env = ( $ENV{SERVER_SOFTWARE} || "" ) =~ /apache/i;
12 0           my $mp = exists $ENV{MOD_PERL};
13 0           $apache{'env'} = $env;
14 0           $apache{'mp'} = $mp;
15 0           bless \%apache;
16             }
17            
18             sub has {
19 0     0 0   my ( $self, @opts ) = @_;
20 0           for my $opt (@opts) {
21 0 0         return 0 unless $self->{$opt};
22             }
23 0           return 1;
24             }
25            
26             sub print_apache {
27            
28 0     0 0   my $self = shift;
29 0           my @mods;
30 0           my ($version, $hostname, $port, $mp_status) = ("Not detected") x 7;
31            
32 0 0         $mp_status = 'enabled' if $self->has(qw(mp));
33            
34             ($version) = $ENV{'SERVER_SOFTWARE'} =~ /(\d+[\.\d]*)/
35 0 0 0       if (defined $ENV{'SERVER_SOFTWARE'} && $ENV{'SERVER_SOFTWARE'} =~ /\d+[\.\d]*/);
36            
37            
38             return join '', print_table_row(2, "Apache Version", "$version"),
39 0 0 0       (defined($ENV{'SERVER_NAME'}) && defined($ENV{'SERVER_PORT'})) ?
40             print_table_row(2, "Hostname:Port", "$ENV{'SERVER_NAME'} : $ENV{'SERVER_PORT'}"):
41             print_table_row(2, "Hostname:Port", "$hostname : $port"),
42             print_table_row(2, "mod_perl", "$mp_status");
43             }
44            
45             sub print_modperl {
46            
47 0     0 0   my ($version_status, $version_number) = ("Not detected") x 3;
48            
49 0           $version_status = '1.0';
50 0 0 0       $version_status = '2.0 or higher' if $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2;
51 0           ($version_number) = $ENV{MOD_PERL} =~ /^\S+\/(\d+(?:[\.\_]\d+)+)/;
52 0           $version_number =~ s/_//g;
53 0           $version_number =~ s/(\.[^.]+)\./$1/g;
54 0 0         unless ($version_status eq '2.0 or higher') {
55 0 0         if ( $version_number >= 1.9901 ) {
56 0           $version_status = '1.9 which is incompatible with 2.0';
57             }
58             }
59            
60 0           return join '', print_box_start(0),
61             "Running under mod_perl version $version_status (version number: $version_number)",
62             print_box_end();
63            
64             }
65            
66             sub print_apache_environment {
67            
68            
69             return join '', print_table_row(2, "DOCUMENT_ROOT", $ENV{'DOCUMENT_ROOT'}),
70             print_table_row(2, "HTTP_ACCEPT", $ENV{'HTTP_ACCEPT'}),
71             print_table_row(2, "HTTP_ACCEPT_CHARSET", $ENV{'HTTP_ACCEPT_CHARSET'}),
72             print_table_row(2, "HTTP_ACCEPT_ENCODING", $ENV{'HTTP_ACCEPT_ENCODING'}),
73             print_table_row(2, "HTTP_ACCEPT_LANGUAGE", $ENV{'HTTP_ACCEPT_LANGUAGE'}),
74             print_table_row(2, "HTTP_CONNECTION", $ENV{'HTTP_CONNECTION'}),
75             print_table_row(2, "HTTP_HOSTS", $ENV{'HTTP_HOSTS'}),
76             print_table_row(2, "HTTP_KEEP_ALIVE", $ENV{'HTTP_KEEP_ALIVE'}),
77             print_table_row(2, "HTTP_USER_AGENT", $ENV{'HTTP_USER_AGENT'}),
78             print_table_row(2, "PATH", $ENV{'PATH'}),
79             print_table_row(2, "REMOTE_ADDR", $ENV{'REMOTE_ADDR'}),
80             print_table_row(2, "REMOTE_HOST", $ENV{'REMOTE_HOST'}),
81             print_table_row(2, "REMOTE_PORT", $ENV{'REMOTE_PORT'}),
82             print_table_row(2, "SCRIPT_FILENAME", $ENV{'SCRIPT_FILENAME'}),
83             print_table_row(2, "SCRIPT_URI", $ENV{'SCRIPT_URI'}),
84             print_table_row(2, "SCRIPT_URL", $ENV{'SCRIPT_URL'}),
85             print_table_row(2, "SERVER_ADDR", $ENV{'SERVER_ADDR'}),
86             print_table_row(2, "SERVER_ADMIN", $ENV{'SERVER_ADMIN'}),
87             print_table_row(2, "SERVER_NAME", $ENV{'SERVER_NAME'}),
88             print_table_row(2, "SERVER_PORT", $ENV{'SERVER_PORT'}),
89             print_table_row(2, "SERVER_SIGNATURE", $ENV{'SERVER_SIGNATURE'}),
90             print_table_row(2, "SERVER_SOFTWARE", $ENV{'SERVER_SOFTWARE'}),
91             print_table_row(2, "GATEWAY_INTERFACE", $ENV{'GATEWAY_INTERFACE'}),
92             print_table_row(2, "SERVER_PROTOCOL", $ENV{'SERVER_PROTOCOL'}),
93             print_table_row(2, "REQUEST_METHOD", $ENV{'REQUEST_METHOD'}),
94             print_table_row(2, "QUERY_STRING", $ENV{'QUERY_STRING'}),
95             print_table_row(2, "REQUEST_URI", $ENV{'REQUEST_URI'}),
96 0     0 0   print_table_row(2, "SCRIPT_NAME", $ENV{'SCRIPT_NAME'});
97            
98             }
99             1;
100