Apache2-SSI

 view release on metacpan or  search on metacpan

t/70.file.t  view on Meta::CPAN

ok( $f->code == 200, 'code' );

my $f2 = $f->clone;

{
    no warnings 'Apache2::SSI::File';
    $f2->filename( "${dir}/ssi/../ssi/plop.pl" );
}

diag( "Filename is: ", $f2->filename, " and I am expecting ", File::Spec->catdir( $dir, URI::file->new( '/ssi/plop.pl' )->file( $^O ) ) ) if( $DEBUG );
ok( $f2->filename eq File::Spec->catdir( $dir, URI::file->new( '/ssi/plop.pl' )->file( $^O ) ), 'filename' );

ok( $f2->code == 404, 'code failed' );

# Access to finfo
my $finfo = $f->finfo;
diag( "File ", File::Spec->catdir( $dir, URI::file->new( "/${file}" )->file( $^O ) ), " mode is: '", ( (CORE::stat( File::Spec->catpath( $dir, URI::file->new( "/${file}" )->file( $^O ) ) ))[2] & 07777 ), "' vs finfo one: '", $f->finfo->mode, "'" ) if...
ok( ( (CORE::stat( File::Spec->catdir( $dir, URI::file->new( "/${file}" )->file( $^O ) ) ))[2] & 07777 ) eq $f->finfo->mode, 'finfo' );

ok( $f->finfo->is_file, 'finfo is_file' );

ok( $f->parent->filename eq File::Spec->catdir( $dir, URI::file->new( '/ssi' )->file( $^O ) ), 'parent' );

SKIP:
{
    my $tests = [
        'Apache2::SSI::File object',
        'Non-existing file object',
        'Non-existing file code',
        'Non-existing file type',
        'filename',
        'updated bad filename',
        'updated bad filename code',
        'updated bad filename filetype',
        'finfo',
        'finfo is_file',
        'parent',
    ];
    if( HAS_APACHE_TEST )
    {
        for( my $i = 0; $i < scalar( @$tests ); $i++ )
        {
            my( $ct, $resp ) = &make_request( sprintf( '/tests/test%02d', $i + 20 ) );
            ok( $ct->[0] eq 'ok', sprintf( '%s with Apache test No %d', $tests->[$i], ( $i + 1 ) ) );
            if( $ct->[0] ne 'ok' && scalar( @$ct ) > 1 )
            {
                diag( "Test No $i failed with returned code ", $resp->code, ": ", join( "\n", @$ct[1..$#$ct] ) );
            }
        }
    }
    else
    {
        skip( "Apache mod_perl is not enabled, skipping.", scalar( @$tests ) );
    }
};

sub make_request
{
    my $uri = shift( @_ );
    my $resp = GET( $uri );
    my $result = [split( /\n/, Encode::decode( 'utf8', $resp->content ) )];
    return( wantarray() ? ( $result, $resp ) : $result );
}



( run in 0.469 second using v1.01-cache-2.11-cpan-39bf76dae61 )