view release on metacpan or  search on metacpan

t/14a-fake_apache.t  view on Meta::CPAN

# Test add().
ok( $h->{Hey} = 1, "Set 'Hey' to 1" );
ok( $h->add('Hey', 2), "Add another value to 'Hey'" );

# Fetch both values at once.
is_deeply( [$h->get('Hey')], [1,2], "Get array for 'Hey'" );
is( scalar $h->get('Hey'), 1, "Get first 'Hey' value only" );

# Try do(). The code ref should be executed twice, once for each value
# in the 'Hey' array reference.
my $i;
$h->do( sub {
    my ($k, $v) = @_;
    is( $k, 'Hey', "Check key in 'do'" );
    is( $v, ++$i, "Check value in 'do'" );
});

# Try short-circutiting do(). The code ref should be executed only once,
# because it returns a false value.
$h->do( sub {
    my ($k, $v) = @_;
    is( $k, 'Hey', "Check key in short 'do'" );
    is( $v, 1, "Check value in short 'do'" );
    return;
});

# Test set() and get().
ok( $h->set('Hey', 'bar'), "Set 'Hey' to 'bar'" );
is( $h->{Hey}, 'bar', "Get 'Hey'" );
is( $h->get('Hey'), 'bar', "Get 'Hey' with get()" );

# Try merge().
ok( $h->merge(Hey => 'you'), "Add 'you' to 'Hey'" );
is( $h->{Hey}, 'bar,you', "Get 'Hey'" );
is( $h->get('Hey'), 'bar,you', "Get 'Hey' with get()" );

# Try unset().
ok( $h->unset('Hey'), "Unset 'Hey'" );
ok( ! exists $h->{Hey}, "Hey doesn't exist" );
is( $h->{Hey}, undef, 'Hey is undef' );

# Try clear().
ok( $h->{Foo} = 'bar', "Add Foo value" );
$h->clear;
ok( ! exists $h->{Foo}, "Hey doesn't exist" );
is( $h->{Foo}, undef, 'Hey is undef' );

# Set up some environment variables.
%ENV = ( 'SCRIPT_NAME'          => '/login/welcome.html',
         'REQUEST_METHOD'       => 'GET',
         'HTTP_ACCEPT'          => 'text/html',
         'HTTP_USER_AGENT'      => 'Mozilla/5.0',
         'HTTP_CACHE_CONTROL'   => 'max-age=0',
         'HTTP_ACCEPT_LANGUAGE' => 'en-us,en;q=0.5',
         'HTTP_KEEP_ALIVE'      => '300',
         'GATEWAY_INTERFACE'    => 'CGI-Perl/1.1',
         'DOCUMENT_ROOT'        => '/usr/local/bricolage/comp',
         'HTTP_REFERER'         => 'http://localhost/',
         'HTTP_ACCEPT_ENCODING' => 'gzip,deflate',
         'HTTP_CONNECTION'      => 'keep-alive',
         'HTTP_ACCEPT_CHARSET'  => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7',
         'HTTP_COOKIE'          => 'FOO=BAR; HEY=You',
         'HTTP_HOST'            => 'localhost',
         'AUTH_TYPE'            => 'Something',
         'CONTENT_TYPE'         => 'text/html',
         'CONTENT_LENGTH'       => 42,
         'REQUEST_METHOD'       => 'GET',
         'PATH_INFO'            => '/index.html',
         'QUERY_STRING'         => "foo=1&bar=2&you=3&you=4",
       );

# Now create a fake apache object.
ok( my $r = HTML::Mason::FakeApache->new, "Create new FakeApache" );

# Check its basic methods.
is( $r->method, $ENV{REQUEST_METHOD}, "Check request method" );
ok( $r->content_type('text/xml'), 'Set content type' );
is( $r->content_type, 'text/xml', 'Check content type' );

# Check the headers out.
ok( $h = $r->headers_out, "Get headers out" );
is( $h->{'Content-Type'}, 'text/xml', 'Check header content-type' );
is( $h->{'content-type'}, 'text/xml', 'Check lc header content-type' );

# Check with get().
is( $h->get('Content-Type'), 'text/xml', 'Check header content-type' );
is( $h->get('content-type'), 'text/xml', 'Check lc header content-type' );

# Try getting an array.
ok( my %h = $r->headers_out, "Get headers out" );
is( $h{'Content-Type'}, 'text/xml', 'Check header content-type' );
is( $h{'content-type'}, undef, 'List context returns new hash list' );

# Try assigning a new value via header_out().
ok( $r->header_out('Annoyance-Level' => 'high'), "Set annoyance level" );
is( $r->header_out('Annoyance-Level'), 'high', "Check annoyance level" );
is( $h->{'annoyance-level'}, 'high', "Check the hash directly" );
ok( $h->unset('annoyance-level'), 'Unset annoyance level' );
is( $r->header_out('Annoyance-Level'), undef, "Check annoyance level again" );
is( $h->{'annoyance-level'}, undef, "Check the hash directly again" );

# Add some cookies
ok( $r->headers_out()->add('Set-Cookie' => 'AF_SID=6e8834d8787ee57a; path=/'), "Set cookie" );
ok( $r->headers_out()->add('Set-Cookie' => 'uniq_id=5608074; path=/; expires=Tue, 26-Aug-2008 21:27:03 GMT'), "Set cookie" );

# Now check err_headers_out.
my $url = 'http://example.com/';
ok( my $e = $r->err_headers_out, "Get error headers out" );
is( scalar keys %$e, 0, "Check for no error headers out" );
ok( $r->err_header_out(Location => $url), "Set location header" );
is( $e->{Location}, $url, "Check Location" );
is( $e->{location}, $url, "Check location" );
is( $e->get('Location'), $url, "Get Location" );
is( $e->get('location'), $url, "Get location" );

# Now check headers_in().
is( $r->header_in('User-Agent'), $ENV{HTTP_USER_AGENT}, "Check user agent" );
ok( $h = $r->headers_in, "Get headers in table" );
is( $h->{Referer}, $ENV{HTTP_REFERER}, "Check referer" );
is( $h->get('Content-Type'), $ENV{CONTENT_TYPE}, "Check in content type" );