diff --git a/Changes b/Changes index 0d5df54..e5271bc 100644 --- a/Changes +++ b/Changes @@ -3,6 +3,7 @@ Revision history for CGI-Info 0.81 Use Test::Needs Added t/version.t + Added t/tabs.t 0.80 Fri Jan 19 08:05:29 EST 2024 Added documentroot() as a synonym to rootdir() diff --git a/MANIFEST b/MANIFEST index 8e2dc78..7e352eb 100644 --- a/MANIFEST +++ b/MANIFEST @@ -61,6 +61,7 @@ t/script.t t/site.t t/status.t t/strict.t +t/tabs.t t/taint.t t/tmpdir.t t/untaint.t diff --git a/Makefile.PL b/Makefile.PL index bdb7607..efc014a 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -14,10 +14,9 @@ WriteMakefile( AUTHOR => q{Nigel Horne }, VERSION_FROM => 'lib/CGI/Info.pm', ABSTRACT_FROM => 'lib/CGI/Info.pm', - ((defined($ExtUtils::MakeMaker::VERSION) && - ($ExtUtils::MakeMaker::VERSION >= 6.3002)) - ? ('LICENSE'=> 'GPL') - : ()), + ((defined($ExtUtils::MakeMaker::VERSION) && ($ExtUtils::MakeMaker::VERSION >= 6.3002)) + ? ('LICENSE'=> 'GPL') + : ()), 'LIBS' => [''], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' 'INC' => '', # e.g., '-I/usr/include/other' diff --git a/bin/info.pl b/bin/info.pl index 9da1e32..914fa08 100755 --- a/bin/info.pl +++ b/bin/info.pl @@ -44,7 +44,7 @@ "Cookies:\n"; foreach my $cookie(split (/; /, $ENV{'HTTP_COOKIE'})) { - my ($key, $value) = split(/=/, $cookie); + my ($key, $value) = split(/=/, $cookie); print "Cookie $key:\n"; my $c = $info->get_cookie(cookie_name => $key); diff --git a/lib/CGI/Info.pm b/lib/CGI/Info.pm index 73f5981..2753c61 100644 --- a/lib/CGI/Info.pm +++ b/lib/CGI/Info.pm @@ -155,8 +155,7 @@ sub _find_paths { } $self->{script_path} = File::Spec->catfile($ENV{'DOCUMENT_ROOT' }, $script_name); } elsif($ENV{'SCRIPT_NAME'} && !$ENV{'DOCUMENT_ROOT'}) { - if(File::Spec->file_name_is_absolute($ENV{'SCRIPT_NAME'}) && - (-r $ENV{'SCRIPT_NAME'})) { + if(File::Spec->file_name_is_absolute($ENV{'SCRIPT_NAME'}) && (-r $ENV{'SCRIPT_NAME'})) { # Called from a command line with a full path $self->{script_path} = $ENV{'SCRIPT_NAME'}; } else { @@ -1370,7 +1369,7 @@ Is the visitor a real person or a robot? my $info = CGI::Info->new(); unless($info->is_robot()) { - # update site visitor statistics + # update site visitor statistics } =cut diff --git a/t/is_mobile.t b/t/is_mobile.t index a95aa0f..653fb06 100644 --- a/t/is_mobile.t +++ b/t/is_mobile.t @@ -10,7 +10,7 @@ BEGIN { } MOBILE: { - delete $ENV{'HTTP_X_WAP_PROFILE'}; + delete $ENV{'HTTP_X_WAP_PROFILE'}; delete $ENV{'HTTP_USER_AGENT'}; my $i = new_ok('CGI::Info'); @@ -22,7 +22,7 @@ MOBILE: { ok($i->is_mobile() == 1); ok($i->browser_type eq 'mobile'); - delete $ENV{'HTTP_X_WAP_PROFILE'}; + delete $ENV{'HTTP_X_WAP_PROFILE'}; $ENV{'HTTP_SEC_CH_UA_MOBILE'} = '?0'; $i = new_ok('CGI::Info'); cmp_ok($i->is_mobile(), '==', 0, 'CH_UA_MOBILE = 0 => !mobile'); diff --git a/t/is_tablet.t b/t/is_tablet.t index 715aa5a..3a183bd 100644 --- a/t/is_tablet.t +++ b/t/is_tablet.t @@ -10,7 +10,7 @@ BEGIN { } PATHS: { - delete $ENV{'HTTP_X_WAP_PROFILE'}; + delete $ENV{'HTTP_X_WAP_PROFILE'}; delete $ENV{'HTTP_USER_AGENT'}; my $i = new_ok('CGI::Info'); @@ -20,7 +20,7 @@ PATHS: { $i = new_ok('CGI::Info'); ok($i->is_tablet() == 0); - delete $ENV{'HTTP_X_WAP_PROFILE'}; + delete $ENV{'HTTP_X_WAP_PROFILE'}; $ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (iPhone; U)'; $i = new_ok('CGI::Info'); ok($i->is_tablet() == 0); diff --git a/t/pod-coverage.t b/t/pod-coverage.t index cb80b52..c541ab6 100644 --- a/t/pod-coverage.t +++ b/t/pod-coverage.t @@ -7,14 +7,14 @@ if($ENV{'AUTHOR_TESTING'}) { my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan(skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage") - if $@; + if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan(skip_all => "Pod::Coverage $min_pc required for testing POD coverage") - if $@; + if $@; all_pod_coverage_ok(); } else { diff --git a/t/pod-snippets.t b/t/pod-snippets.t index 525e1a7..c845e1e 100644 --- a/t/pod-snippets.t +++ b/t/pod-snippets.t @@ -3,19 +3,14 @@ use strict; use warnings; use Test::Most; +use Test::Needs 'Test::Pod::Snippets'; -if($ENV{AUTHOR_TESTING}) { - eval 'use Test::Pod::Snippets'; +if($ENV{'AUTHOR_TESTING'}) { + my @modules = qw/ CGI::Info /; + Test::Pod::Snippets->import(); + Test::Pod::Snippets->new()->runtest(module => $_, testgroup => 1) for @modules; - if($@) { - plan(skip_all => 'Test::Pod::Snippets required for testing POD code snippets'); - } else { - my @modules = qw/ CGI::Info /; - - Test::Pod::Snippets->new()->runtest(module => $_, testgroup => 1) for @modules; - - done_testing(); - } + done_testing(); } else { plan(skip_all => 'Author tests not required for installation'); } diff --git a/t/protocol.t b/t/protocol.t index c22ec9a..332201e 100644 --- a/t/protocol.t +++ b/t/protocol.t @@ -32,7 +32,7 @@ PROTOCOL: { ok($i->protocol() eq 'https'); $ENV{'SERVER_PORT'} = 443; - delete $ENV{'SCRIPT_URI'}; + delete $ENV{'SCRIPT_URI'}; $i = new_ok('CGI::Info'); ok($i->protocol() eq 'https'); ok(CGI::Info->protocol() eq 'https'); diff --git a/t/script.t b/t/script.t index 3afb343..d1fe847 100644 --- a/t/script.t +++ b/t/script.t @@ -13,9 +13,9 @@ BEGIN { } PATHS: { - delete $ENV{'SCRIPT_NAME'}; + delete $ENV{'SCRIPT_NAME'}; delete $ENV{'DOCUMENT_ROOT'}; - delete $ENV{'SCRIPT_FILENAME'}; + delete $ENV{'SCRIPT_FILENAME'}; my $i = new_ok('CGI::Info'); ok(File::Spec->file_name_is_absolute($i->script_path())); @@ -74,7 +74,7 @@ PATHS: { $ENV{'DOCUMENT_ROOT'} = '/path/to'; $ENV{'SCRIPT_NAME'} = '/cgi-bin/bar.pl'; - delete $ENV{'SCRIPT_FILENAME'}; + delete $ENV{'SCRIPT_FILENAME'}; $i = new_ok('CGI::Info'); ok($i->script_name() eq 'bar.pl'); @@ -87,9 +87,9 @@ PATHS: { ok($i->script_path() eq '/path/to/cgi-bin/bar.pl'); } - delete $ENV{'DOCUMENT_ROOT'}; + delete $ENV{'DOCUMENT_ROOT'}; $ENV{'SCRIPT_NAME'} = '/cgi-bin/bar.pl'; - delete $ENV{'SCRIPT_FILENAME'}; + delete $ENV{'SCRIPT_FILENAME'}; $i = new_ok('CGI::Info'); ok($i->script_name() eq 'bar.pl'); diff --git a/t/site.t b/t/site.t index abc9eda..a99355a 100644 --- a/t/site.t +++ b/t/site.t @@ -13,8 +13,8 @@ BEGIN { } HOSTNAMES: { - delete $ENV{'HTTP_HOST'}; - delete $ENV{'SERVER_NAME'}; + delete $ENV{'HTTP_HOST'}; + delete $ENV{'SERVER_NAME'}; $ENV{'SERVER_PORT'} = 80; my $i = new_ok('CGI::Info' => [ logger => MyLogger->new() ]); @@ -53,7 +53,7 @@ HOSTNAMES: { # Check rereading returns the same value ok($i->domain_name() eq 'example.com'); - delete $ENV{'HTTP_HOST'}; + delete $ENV{'HTTP_HOST'}; delete $ENV{'SCRIPT_URI'}; $ENV{'SERVER_NAME'} = 'www.bandsman.co.uk'; diff --git a/t/tabs.t b/t/tabs.t new file mode 100644 index 0000000..3310ba3 --- /dev/null +++ b/t/tabs.t @@ -0,0 +1,16 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use Test::Needs 'Test::Tabs'; +use Test::Most; + +BEGIN { + if($ENV{'AUTHOR_TESTING'}) { + Test::Tabs->import(); + all_perl_files_ok(); + done_testing(); + } else { + plan(skip_all => 'Author tests not required for installation'); + } +}