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 ? '<hr>' : '<hr />';

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;

    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 = '&amp;';

    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;
}


## clean up ##
test_content('destroy');
rmdir $dir or print "warning: cant rmdir $dir: $!\n";
rmdir "$htdocs/$ai_dir";

sub write_htaccess {
    open (HT, ">$htaccess") or die "cant open $htaccess: $!";
    print HT shift;
    close(HT);

    ## add/update .htaccess to the file hash ##
    ($file{'.htaccess'}{date}, $file{'.htaccess'}{size}) =
        (stat($htaccess))[9,7];
}

## manage test content ##
sub test_content {
    my $what = shift || 'create';
    return undef if ($what ne 'create' and $what ne 'destroy');

    foreach (sort keys %file) {
        my $file = "$dir/$_";
        $file = "$dir/$file_prefix.$_" unless ($_ eq 'README'
            or $_ eq '.htaccess');

        if ($what eq 'destroy') {
            unlink $file or print "warning: cant  unlink $file: $!\n";
            next;
        }

        open (FILE, ">$file") or die "cant open $file: $!";
        if ($_ eq 'README') {
            ## README file will contain actual text ##
            print FILE $readme;
        } else {
            ## everything else is just x's ##
            print FILE "x"x$file{$_}{size};
        }
        close(FILE);
    
        if ($file{$_}{date} == 0) {
            $file{$_}{date} = (stat($file))[9];
        } else {
            utime($file{$_}{date}, $file{$_}{date}, $file)
                or die "cant utime $file: $!";
        }
    
    }

}

