in t/modules/autoindex.t [122:391]
sub ai_test ($$$$) {
my ($htconf,$c,$o,$t_uri) = @_;
my $html_head;
if (have_min_apache_version('2.5.1')) {
$html_head = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">';
}
else {
$html_head = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">';
}
$html_head .= <<HEAD;
<html>
<head>
<title>Index of $uri_prefix</title>
</head>
<body>
<h1>Index of $uri_prefix</h1>
HEAD
my $html_foot = "${hr}</pre>\n</body></html>\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 =~ /<hr \/>/) {
## cope with new-fangled <hr /> tags
$hr = '<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 .=
"<pre> <a href=\"?$name_href\">Name</a> <a href=\"?$date_href\">Last modified</a> <a href=\"?$size_href\">Size</a> <a href=\"?C=D$sep"."O=A\">Description</a>${hr} <a href=\"/modules/autoindex/\">Parent Directory</a> - \n";
$html_foot = "${hr}</pre>\n</body></html>\n";
} else {
$html_head .=
"<pre><a href=\"?$name_href\">name</a> <a href=\"?$date_href\">last modified</a> <a href=\"?$size_href\">size</a> <a href=\"?d=a\">description</a>\n<hr>\n<parent>\n";
$html_foot = "</pre><hr>\n</body></html>\n";
}
} else {
## html for non fancy indexing ##
if ($have_apache_2) {
$html_head .=
"<ul><li><a href=\"/modules/autoindex/\"> Parent Directory</a></li>\n";
$html_foot = "</ul>\n</body></html>\n";
} else {
$html_head .=
"<ul><li><a href=\"/modules/autoindex/\"> Parent Directory</a>\n";
$html_foot = "</ul></body></html>\n";
}
}
## verify html heading ##
my @exp_head = split /\n/, $html_head;
my @actual = split /\n/, $actual;
for ($i=0;$i<@exp_head;$i++) {
$actual[$i] = lc($actual[$i]);
$exp_head[$i] = lc($exp_head[$i]);
if ($actual[$i] eq $exp_head[$i]) {
next;
} else {
if (!$have_apache_2 && $actual[$i] =~ /parent directory/ &&
$exp_head[$i] eq "<parent>") {
## cursory check on this one due to timestamp
## in parent directory line in 1.3
next;
}
print "expect:\n->$exp_head[$i]<-\n";
print "actual:\n->$actual[$i]<-\n";
$fail = 1;
last;
}
}
if ($fail) {
print "failed on html head (C=$c\&O=$o";
print " FancyIndexing" if $FancyIndexing;
print ")\n";
return 0;
}
## file list verification ##
my $e = 0;
for ($i=$i;$file_list[$e] && $actual;$i++) {
my $cmp_string = "<li><a href=\"$file_prefix.$file_list[$e]\"> $file_prefix.$file_list[$e]</a></li>";
$cmp_string = "<li><a href=\"$file_prefix.$file_list[$e]\"> $file_prefix.$file_list[$e]</a>" unless ($have_apache_2);
$cmp_string =
"<a href=\"$file_prefix.$file_list[$e]\">$file_prefix.$file_list[$e]</a>"
if $FancyIndexing;
if ($file_list[$e] eq 'README' or
$file_list[$e] eq '.htaccess') {
$cmp_string =
"<a href=\"$file_list[$e]\">$file_list[$e]</a>"
if $FancyIndexing;
$cmp_string =
"<li><a href=\"$file_list[$e]\"> $file_list[$e]</a>"
unless $FancyIndexing;
}
$actual[$i] = lc($actual[$i]);
$cmp_string = lc($cmp_string);
if ($actual[$i] =~ /$cmp_string/i) {
$e++;
next;
} else {
print "expect:\n->$cmp_string<-\n";
print "actual:\n->$actual[$i]<-\n";
$fail = 1;
last;
}
}
if ($fail) {
print "failed on file list (C=$c\&O=$o";
print " FancyIndexing" if $FancyIndexing;
print ")\n";
exit;
return 0;
}
## the only thing left in @actual should be the foot
my @foot = split /\n/, $html_foot;
$e = 0;
for ($i=$i;$foot[$e];$i++) {
$actual[$i] = lc($actual[$i]);
$foot[$e] = lc($foot[$e]);
if ($actual[$i] ne $foot[$e]) {
$fail = 1;
print "expect:\n->$foot[$e]<-\nactual:\n->$actual[$i]<-\n";
last;
}
$e++;
}
if ($fail) {
print "failed on html footer (C=$c\&O=$o";
print " FancyIndexing" if $FancyIndexing;
print ")\n";
return 0;
}
## and at this point there should be no more @actual
if ($i != @actual) {
print "thats not all! there is more than we expected!\n";
print "i = $i\n";
print "$actual[$i]\n";
print "$actual[$i+1]\n";
return 0;
}
return 1;
}