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 Test::More tests => 9;

use constant DECLINED               => -1;
use constant DIR_MAGIC_TYPE         => 'httpd/unix-directory';
use constant HTTP_MOVED_PERMANENTLY => 301;

{
    package Apache::FakeRequest;
    no warnings 'redefine';
    sub new {
        my $class = shift;
        bless { @_ } => $class;
    }
    sub content_type { shift->{content_type}      }
    sub uri          { shift->{uri}               }
    sub args         { shift->{args}              }
    sub header_out   {
        my $self = shift;
        $self->{header_out} = [@_];
    }
}

BEGIN { use_ok 'Apache::Dir' or die }

my $req = Apache::FakeRequest->new(
    uri => '/foo/',
    content_type => DIR_MAGIC_TYPE,
);
is( Apache::Dir::handler($req), DECLINED, "Check valid URI" );


$req = Apache::FakeRequest->new(
    uri => '/foo',
    content_type => 'foo',
);
is( Apache::Dir::handler($req), DECLINED, "Check valid file" );


$req = Apache::FakeRequest->new(
    uri => '/foo',
    content_type => DIR_MAGIC_TYPE,
);
is( Apache::Dir::handler($req), HTTP_MOVED_PERMANENTLY, "Check invalid URI" );
is( $req->{header_out}[0], 'Location', "Check for Location header");
is( $req->{header_out}[1], '/foo/', "Check Location header value");

my $args = 'bar=bim&boom=hello';
$req = Apache::FakeRequest->new(
    uri => '/foo',
    content_type => DIR_MAGIC_TYPE,
    args => $args
);
is( Apache::Dir::handler($req), HTTP_MOVED_PERMANENTLY, "Check invalid URI with args" );
is( $req->{header_out}[0], 'Location', "Check for Location header");
is( $req->{header_out}[1], "/foo/?$args", "Check Location header value");

__END__