view release on metacpan or  search on metacpan

t/functions.pl  view on Meta::CPAN

        {
            die( "Missing \"expect\" property for test $def->{type} No $i !\nTest data is: ", $ap->dump( $def ) );
        }
        diag( "Checking uri $def->{uri} with legacy '$opts->{legacy}'" ) if( $opts->{debug} > 1 );
        my $ap = Apache2::SSI->new(
            debug => $opts->{debug},
            #document_root => $doc_root,
            #document_uri  => $doc_uri,
            document_root => $DOC_ROOT,
            document_uri => $def->{uri},
            legacy => ( $def->{legacy} ? 1 : 0 ),
            trunk => ( $def->{trunk} ? 1 : 0 ),
        ) || die( "Unable to instantiate a Apache2::SSI object: ", Apache2::SSI->error );
        $ap->remote_ip( $def->{remote_ip} ) if( exists( $def->{remote_ip} ) );
        
        SKIP:
        {
            if( $def->{with_apache} && !$def->{uri} )
            {
                skip( "Missing \"uri\" property to run Apache test.", 1 );
            }
            elsif( ( $opts->{with_apache} && !HAS_APACHE_TEST ) ||
                   ( $def->{requires} eq 'mod_perl' && !$opts->{with_apache} ) )
            {
                skip( "mod_perl is not enabled. Skipping Apache test" . ( $def->{name} ? " for $def->{name}" : '' ) . ".", 1 );
            }
            elsif( length( $def->{skip} ) )
            {
                skip( $def->{skip} . " Skipping test" . ( $def->{name} ? " for $def->{name}" : '' ) . ".", 1 );
            }
        
            if( exists( $def->{sub} ) &&
                ref( $def->{sub} ) eq 'CODE' )
            {
                $def->{sub}->( $ap );
            }
        
            if( $def->{fail} || $def->{no_warning} )
            {
                $ap->quiet( 1 );
            }
        
            my $result = '';
            my $code;
            if( $opts->{with_apache} )
            {
                my $resp = GET( $def->{uri}, ( scalar( keys( %{$def->{headers}} ) ) ? %{$def->{headers}} : () ) );
                $code = $resp->code;
                $result = Encode::decode( 'utf8', $resp->content );
            }
            else
            {
                $ENV{REQUEST_URI} = $def->{uri};
                $ENV{REQUEST_METHOD} = 'GET';
                $ENV{HTTPS} = 'off';
                $ENV{DOCUMENT_ROOT} = $DOC_ROOT;
                if( exists( $def->{headers} ) && ref( $def->{headers} ) eq 'HASH' && scalar( keys( %{$def->{headers}} ) ) )
                {
                    while( my( $header, $value ) = each( %{$def->{headers}} ) )
                    {
                        if( $header eq 'Cookie' )
                        {
                            $ENV{HTTP_COOKIE} = $value;
                        }
                        elsif( $header eq 'Agent' )
                        {
                            $ENV{HTTP_USER_AGENT} = $value;
                        }
                        elsif( $header eq 'Host' )
                        {
                            $ENV{HTTP_HOST} = $value;
                        }
                        elsif( $header eq 'DNT' )
                        {
                            $ENV{HTTP_DNT} = $value;
                        }
                    }
                }
                $result = $ap->parse( $text );
            }
        
            $ap->quiet( 0 );
            diag( "Checking result '$result' ", ( $opts->{with_apache} ? "and code '$code' from uri $def->{uri} " : '' ), "against expected result '$expect'", ( $opts->{with_apache}  ? "and code '$def->{code}'" : '' ), "." ) if( $opts->{debug} > 1 );
            ok( $code == $def->{code}, 'Response code' ) if( $opts->{with_apache} );
            my $check = ( ref( $expect ) eq 'Regexp' ? ( $result =~ /$expect/ ) : ( $result eq $expect ) );
            if( $check )
            {
                ok( $check, sprintf( "$opts->{type} test No %d%s", $i + 1, ( length( $def->{name} ) ? " ($def->{name})" : '' ) . ( $opts->{with_apache} ? ' (using mod_perl2)' : '' ) ) );
            }
            elsif( $def->{fail} )
            {
                pass( sprintf( "$opts->{type} test No %d%s", $i + 1, ( length( $def->{name} ) ? " ($def->{name})" : '' ) . ( $opts->{with_apache} ? ' (using mod_perl2)' : '' ) ) );
            }
            else
            {
                if( $ENV{AUTHOR_TESTING} )
                {
                    diag( "Failed: result found: '$result'. I was expecting '$expect'" );
                }
                fail( sprintf( "$opts->{type} test No %d%s", $i + 1, ( length( $def->{name} ) ? " ($def->{name})" : '' ) . ( $opts->{with_apache} ? ' (using mod_perl2)' : '' ) ) );
            }
        }
    }
}

1;

__END__