The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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 '';
}