#!/usr/bin/perl -w
use strict;
use lib ('./blib','../blib','../lib','./lib');
use CGI::PathInfo;
# General info for writing test modules:
#
# When running as 'make test' the default
# working directory is the one _above_ the
# 't/' directory.
my @do_tests=(1..4);
my $test_subs = {
1 => { -code => \&instantation, -desc => ' instantation ' },
2 => { -code => \&bad_initialization, -desc => ' bad initialization ' },
3 => { -code => \&test1, -desc => ' parameter list ' },
4 => { -code => \&test2, -desc => ' values lists ' },
};
print $do_tests[0],'..',$do_tests[$#do_tests],"\n";
print STDERR "\n";
my $n_failures = 0;
foreach my $test (@do_tests) {
my $sub = $test_subs->{$test}->{-code};
my $desc = $test_subs->{$test}->{-desc};
my $failure = '';
eval { $failure = &$sub; };
if ($@) {
$failure = $@;
}
if ($failure ne '') {
chomp $failure;
print "not ok $test\n";
print STDERR " $desc - $failure\n";
$n_failures++;
} else {
print "ok $test\n";
print STDERR " $desc - ok\n";
}
}
print "END\n";
exit;
########################################
# Instantation #
########################################
sub instantation {
$ENV{'PATH_INFO'} = '/test1a-value1/test1b-value2/fake.html';
my $path_info;
eval {
$path_info = CGI::PathInfo->new;
};
if ($@ or (not $path_info)) {
return 'failed standard instantation';
}
eval {
$path_info = CGI::PathInfo->new( 'stripleadingslash' => 1 );
};
if ($@ or (not $path_info)) {
return 'failed standard instantation with list parameters';
}
eval {
$path_info = CGI::PathInfo->new({ 'stripleadingslash' => 1 });
};
if ($@ or (not $path_info)) {
return 'failed standard instantation with anon hash parameters';
}
eval {
$path_info = CGI::PathInfo::new;
};
if ($@ or (not $path_info)) {
return 'failed class method instantation';
}
eval {
$path_info = new CGI::PathInfo;
};
if ($@ or (not $path_info)) {
return 'failed indirect instantation';
}
eval {
$path_info = CGI::PathInfo->new->new;
};
if ($@ or (not $path_info)) {
return 'failed instance constructor instatation'
}
eval {
local $ENV{'PATH_INFO'};
$path_info = CGI::PathInfo->new;
my @parms = $path_info->param;
if (@parms > 0) {
die ("mis-decoded undef PATH_INFO");
}
};
if ($@ or (not $path_info)) {
return "failed instance constructor instatation $@";
}
return '';
}
########################################
# Bad initialization parameters #
########################################
sub bad_initialization {
$ENV{'PATH_INFO'} = '/test1a-value1/test1b-value2/fake.html';
eval {
my $path_info = CGI::PathInfo->new([ stripleadingslash => 0,
striptrailingslash => 0,
]);
};
unless ($@) {
return 'failed to detect passing of bad parameters';
}
eval {
my $path_info = CGI::PathInfo->new( stripleadingslash => 1,
stlingslash => 1,
);
};
unless ($@) {
return 'failed to detect passing of invalid parameters';
}
eval {
my $path_info = CGI::PathInfo->new({ stripleadingslash => 1,
stlingslash => 1,
});
};
unless ($@) {
return 'failed to detect passing of invalid parameters';
}
eval {
my $path_info = CGI::PathInfo->new('a');
};
unless ($@) {
return 'failed to detect passing of odd number of parameters';
}
eval {
my $path_info = CGI::PathInfo->new( stripleadingslash => 1,
striptrailingslash => 1,
'a',
);
};
unless ($@) {
return 'failed to detect passing of odd number of parameters';
}
eval {
my $path_info = CGI::PathInfo->new( stripingslash => 1,);
};
unless ($@) {
return 'failed to detect passing of undefined parameter';
}
return '';
}
########################################
# Number of returned parameters #
########################################
sub test1 {
{
$ENV{'PATH_INFO'} = '/test1a-value1/test1b-value2/fake.html';
my $path_info = CGI::PathInfo->new({ stripleadingslash => 0,
striptrailingslash => 0,
});
my @parms = $path_info->param;
if ($#parms != 1) {
return 'Incorrect parse of PATH_INFO - wrong number of parameters returned';
}
my @expected = ( 'test1a', 'test1b' );
for (my $count = 0; $count <= $#expected; $count++) {
if($expected[$count] ne $parms[$count]) {
return "Unexpected key of '$parms[$count]' was found";
}
}
}
{
$ENV{'PATH_INFO'} = '/test1a-value1/test1a-value2/fake.html';
my $path_info = CGI::PathInfo->new({ stripleadingslash => 0,
striptrailingslash => 0,
});
my @parms = $path_info->param;
if ($#parms != 0) {
return 'Incorrect parse of PATH_INFO - wrong number of parameters returned';
}
my @expected = ( 'test1a' );
for (my $count = 0; $count <= $#expected; $count++) {
if($expected[$count] ne $parms[$count]) {
return "Unexpected key of '$parms[$count]' was found";
}
}
my @values = $path_info->param('test1a');
unless (2 == @values) {
return 'Incorrect parse of PATH_INFO - wrong number of values returned for multivalue';
}
}
return '';
}
########################################
# Number of returned values #
########################################
sub test2 {
$ENV{'PATH_INFO'} = '/test2b-value1/test2a-value2/test2a-value3/test2a-value4/fake.html';
my $path_info = CGI::PathInfo->new;
my $expected_results = { 'test2a' => [qw(value1)],
'test2a' => [qw(value2 value3 value4)],
};
foreach my $test_key (keys %$expected_results) {
my (@values) = $path_info->param($test_key);
if ($#values != $#{$expected_results->{$test_key}}) {
return "Incorrect parse of PATH_INFO - wrong number of values returned for '$test_key'";
}
foreach my $test_value (@{$expected_results->{$test_key}}) {
if ($#values != $#{$expected_results->{$test_key}}) {
return "Incorrect parse of PATH_INFO - unexpected values returned for '$test_key'";
}
}
}
my @no_such = $path_info->param('no such parm');
unless (0 == @no_such) {
return 'found a param that should not have existed';
}
return '';
}