use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestRequest;
##
## mod_autoindex test
##
## 9-4-01
## this only tests for a very limited set of functionality
## in the autoindex module. namely, file sorting and display
## with IndexOrderDefault directive and FancyIndexing.
## more to come...
my $htdocs = Apache::Test::vars('documentroot');
my $ai_dir = "/modules/autoindex";
my $uri_prefix = "$ai_dir/htaccess";
my $dir = "$htdocs$uri_prefix";
my $htaccess = "$dir/.htaccess";
my $readme = 'autoindex test README';
my $s = 'HITHERE';
my $uri = "$uri_prefix/";
my $file_prefix = 'ai-test';
my ($C,$O);
my $cfg = Apache::Test::config();
my $have_apache_2 = have_apache 2;
my $hr = $have_apache_2 ? '
' : '
';
my %file =
(
README =>
{
size => length($readme),
date => 998932210
},
txt =>
{
size => 5,
date => 998934398
},
jpg =>
{
size => 15,
date => 998936491
},
gif =>
{
size => 1568,
date => 998932291
},
html =>
{
size => 9815,
date => 922934391
},
doc =>
{
size => 415,
date => 998134391
},
gz =>
{
size => 1,
date => 998935991
},
tar =>
{
size => 1009845,
date => 997932391
},
php =>
{
size => 913515,
date => 998434391
}
);
plan tests => 84, ['autoindex'];
## set up environment ##
$cfg->gendir("$htdocs/$ai_dir");
$cfg->gendir("$dir");
test_content('create');
## run tests ##
foreach my $fancy (0,1) {
## test default order requests ##
foreach my $order (qw(Ascending Descending)) {
$O = substr($order, 0, 1);
foreach my $component (qw(Name Date Size)) {
$C = substr($component, 0, 1);
$C = 'M' if $C eq 'D';
my $config_string = '';
$config_string = "IndexOptions FancyIndexing\n" if $fancy;
$config_string .= "IndexOrderDefault $order $component\n";
print "---\n$config_string\n";
sok { ai_test($config_string,$C,$O,$uri) };
## test explicit order requests ##
foreach $C (qw(N M S)) {
foreach $O (qw(A D)) {
my $test_uri;
if ($have_apache_2) {
$test_uri = "$uri?C=$C\&O=$O";
} else {
$test_uri = "$uri?$C=$O";
}
print "---\n$config_string\n(C=$C O=$O)\n";
sok { ai_test($config_string,$C,$O,$test_uri) };
}
}
}
}
}
sub ai_test ($$$$) {
my ($htconf,$c,$o,$t_uri) = @_;
my $html_head = <
Index of $uri_prefix
Index of $uri_prefix
HEAD
my $html_foot = "${hr}\n\n";
my $i;
my $fail = 0;
my $FancyIndexing = ($htconf =~ /FancyIndex/);
write_htaccess($htconf);
my $actual = GET_BODY $t_uri;
print "GET $t_uri\n";
################################
## this may not be ok! ##
##----------------------------##
## should you be able to sort ##
## by components other than ##
## name when FancyIndexing is ##
## not on? ##
################################
$c = 'N' unless $FancyIndexing;#
################################
## end questionable block ##
################################
my @file_list;
if ($o =~ /^A$/i) {
## sort ascending ##
if ($c =~ /^N$/i) {
## by name ##
@file_list = sort keys %file;
} elsif ($c =~ /^S$/i) {
## by size ##
@file_list =
sort {$file{$a}{size} <=> $file{$b}{size}} keys %file;
} elsif ($c =~ /^M$/i) {
## by date ##
@file_list =
sort {$file{$a}{date} <=> $file{$b}{date}} keys %file;
} else {
print "big error: C=$c, O=$o\n";
return 0;
}
} elsif ($o =~ /^D$/i) {
## sort decending ##
if ($c =~ /^N$/i) {
## by name ##
@file_list = reverse sort keys %file;
} elsif ($c =~ /^S$/i) {
## by size ##
@file_list =
sort {$file{$b}{size} <=> $file{$a}{size}} keys %file;
} elsif ($c =~ /^M$/i) {
## by date ##
@file_list =
sort {$file{$b}{date} <=> $file{$a}{date}} keys %file;
} else {
print "big error: C=$c, O=$o\n";
return 0;
}
} else {
print "big error: C=$c, O=$o\n";
return 0;
}
my $sep = '&';
if ($have_apache_2 && $actual =~ /\?C=.\;/) {
## cope with new 2.1-style headers which use a semi-colon
## to separate query segment parameters
$sep = ';';
}
if ($actual =~ /
/) {
## cope with new-fangled
tags
$hr = '
';
}
## set up html for fancy indexing ##
if ($FancyIndexing) {
my $name_href;
my $date_href;
my $size_href;
if ($have_apache_2) {
$name_href = 'C=N'.$sep.'O=A';
$date_href = 'C=M'.$sep.'O=A';
$size_href = 'C=S'.$sep.'O=A';
} else {
$name_href = 'N=A';
$date_href = 'M=A';
$size_href = 'S=A';
}
foreach ($name_href, $date_href, $size_href) {
if ($have_apache_2) {
if ($_ =~ /^C=$c/i) {
#print "changed ->$_<- to ";
$_ = "C=$c$sep"."O=A" if $o =~ /^D$/i;
$_ = "C=$c$sep"."O=D" if $o =~ /^A$/i;
last;
}
} else {
if ($_ =~ /^$c=/i) {
$_ = "$c=A" if $o =~ /^D$/i;
$_ = "$c=D" if $o =~ /^A$/i;
last;
}
}
}
if ($have_apache_2) {
$html_head .=
" Name Last modified Size Description${hr} Parent Directory - \n";
$html_foot = "${hr}\n