view release on metacpan or  search on metacpan

t/001.t  view on Meta::CPAN

$expected=GET_BODY("/perldoc/d::p");
$resp=GET '/perldoc/d::p', 'Accept-Encoding'=>'gzip,deflate';
like $resp->header('Vary'), qr/\bAccept-Encoding\b/i, 'Vary Header';
is $resp->header('Content-Encoding'), 'deflate', 'Content-Encoding';

$expected=~s/<!--.*?-->//sg;
{
    my $got=uncompress($resp->content);
    $got=~s/<!--.*?-->//sg;
    is $got, $expected, 'inflated body';
}

##########################################
# stylesheets
##########################################
t_debug 'Testing stylesheet access';

foreach (qw!/perldoc/dummy.css /NOINC/dummy.css!) {
    is GET($_)->code, 404, $_.': 404';
}

foreach (qw!/perldoc/auto.css /NOINC/fancy.css
            /perldoc/sub/dir/auto.css /NOINC/sub/dir/fancy.css!) {
    is GET($_)->code, 200, $_.': 200';
}

$expected=GET_BODY("/perldoc/fancy.css");
$resp=GET '/perldoc/fancy.css', 'Accept-Encoding'=>'gzip,deflate';
like $resp->header('Vary'), qr/\bAccept-Encoding\b/i, 'Vary Header';
is $resp->header('Content-Encoding'), 'gzip', 'Content-Encoding';

$expected=~s/<!--.*?-->//sg;
{
    my $got=Compress::Zlib::memGunzip($resp->content);
    $got=~s/<!--.*?-->//sg;
    is $got, $expected, 'ungzipped body';
}

##########################################
# torsten-foertsch.jpg
##########################################
t_debug 'Testing torsten-foertsch.jpg';

$resp=GET("/perldoc/Apache2::PodBrowser/torsten-foertsch.jpg");
is $resp->code, 200, 'Code';
is $resp->header('Content-Length'),
    (-s t_catfile Apache::Test::vars->{top_dir},
                  qw/blib lib Apache2 PodBrowser torsten-foertsch.jpg/),
    'Image Size';
is $resp->header('Content-Type'), 'image/jpeg', 'Content Type';

my $bodylen=length $resp->content;
is $bodylen, $resp->header('Content-Length'), 'resp body size';

$resp=GET("/perldoc/Apache2::PodBrowser/torsten-foertsch.jpg?ct=text/plain");
is length $resp->content, $bodylen, 'resp body size 2';
is $resp->header('Content-Type'), 'text/plain', 'Content Type 2';

SKIP: {
    skip "BrowserMatch needs mod_setenvif", 12
        unless have_module 'mod_setenvif.c';
    ##########################################
    # BrowserMatch
    ##########################################
    t_debug 'Testing BrowserMatch';

    Apache::TestRequest::user_agent(reset => 1,
                                    requests_redirectable => 0,
                                    agent => 'I am MSIE. Nice to meet you!');

    $expected=GET_BODY("/perldoc/fancy.css");
    $resp=GET '/perldoc/fancy.css', 'Accept-Encoding'=>'gzip,deflate';
    like $resp->header('Vary'), qr/\bAccept-Encoding\b/i, 'Vary Header';
    is $resp->header('Content-Encoding'), undef, 'Content-Encoding';
    is $resp->content, $expected, 'plain body';

    $expected=GET_BODY("/perldoc/d::p");
    $resp=GET '/perldoc/d::p', 'Accept-Encoding'=>'gzip,deflate';
    like $resp->header('Vary'), qr/\bAccept-Encoding\b/i, 'Vary Header';
    is $resp->header('Content-Encoding'), undef, 'Content-Encoding';
    is $resp->content, $expected, 'plain body';

    Apache::TestRequest::user_agent(reset => 1,
                                    requests_redirectable => 0,
                                    agent => 'I am HUHU. Nice to meet you!');

    $expected=GET_BODY("/perldoc/fancy.css");
    $resp=GET '/perldoc/fancy.css', 'Accept-Encoding'=>'gzip,deflate';
    like $resp->header('Vary'), qr/\bAccept-Encoding\b/i, 'Vary Header';
    is $resp->header('Content-Encoding'), undef, 'Content-Encoding';
    is $resp->content, $expected, 'plain body';

    $expected=GET_BODY("/perldoc/d::p");
    $resp=GET '/perldoc/d::p', 'Accept-Encoding'=>'gzip,deflate';
    like $resp->header('Vary'), qr/\bAccept-Encoding\b/i, 'Vary Header';
    is $resp->header('Content-Encoding'), 'deflate', 'Content-Encoding';

    $expected=~s/<!--.*?-->//sg;
    {
        my $got=uncompress($resp->content);
        $got=~s/<!--.*?-->//sg;
        is $got, $expected, 'inflated body';
    }
}