view release on metacpan or  search on metacpan

t/001.t  view on Meta::CPAN

        $resp=GET '/cached/';
        t_debug 'Cache usage took '.(Time::HiRes::time-$time).' sec.';
    }

    like $resp->content, qr/>d::p2</, 'd::p2 now found';
}

##########################################
# perldoc -f mode
##########################################
t_debug 'Testing perldoc -f mode';

$resp=GET_BODY("/perldoc/?abs");

like $resp, qr!href="\./"!, '"Pod Index" link';
like $resp, qr!href="\./\?\?"!, '"Function Index" link';

like $resp, qr!>abs VALUE\b!, 'abs VALUE (first =item)';
like $resp, qr~>abs(?! VALUE\b)~, 'abs (2nd =item)';

# in NOINC mode it must generate the same output
$expected=$resp;
$resp=GET_BODY("/NOINC/?abs");
$resp=~s/NOINC/perldoc/g;

is $resp, $expected, 'same output with NOINC';

$expected=GET_BODY("/perldoc/?ref");
$resp=GET '/perldoc/?ref', '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';
}

##########################################
# perldoc mode
##########################################
t_debug 'Testing perldoc mode';

$resp=GET_BODY("/perldoc/d::p");

like $resp, qr!NAME bla</a></h1>!, 'got it';
like $resp, qr!href="\./"!, '"Pod Index" link';
like $resp, qr!href="\./\?\?"!, '"Function Index" link';

like $resp, qr!a href="\./other::module#Head2"!, 'link to existing module';
like $resp, qr!a href="\./missing::module#section"!,
    'link to missing module';

$resp=GET_BODY("/perldoc/perlfunc");

like $resp, qr!>Alphabetical Listing of Perl Functions</a></h2>!, 'perlfunc';

$resp=GET("/NOINC/perlfunc");

is $resp->code, 404, '/NOINC/perlfunc: 404';

$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';