view release on metacpan or  search on metacpan

lib/Apache/TestHandler.pm  view on Meta::CPAN

sub ok1 {
    my ($r, $boolean) = @_;
    Apache::Test::plan($r, tests => 1);
    Apache::Test::ok(@_==1 || $boolean);
    0;
}

# a fixup handler to be used when a few requests need to be run
# against the same perl interpreter, in situations where there is more
# than one client running. For an example of use see
# modperl-2.0/t/response/TestModperl/interp.pm and
# modperl-2.0/t/modperl/interp.t
#
# this handler expects the header X-PerlInterpreter in the request
# - if none is set, Apache::SERVER_ERROR is returned
# - if its value eq 'tie', instance's global UUID is assigned and
#   returned via the same header
# - otherwise if its value is not the same the stored instance's
#   global UUID Apache::NOT_FOUND is returned
#
# in addition $same_interp_counter counts how many times this instance of
# pi has been called after the reset 'tie' request (inclusive), this
# value can be retrieved with Apache::TestHandler::same_interp_counter()
my $same_interp_id = "";
# keep track of how many times this instance was called after the reset
my $same_interp_counter = 0;
sub same_interp_counter { $same_interp_counter }
sub same_interp_fixup {
    my $r = shift;
    my $interp = $r->headers_in->get(Apache::TestRequest::INTERP_KEY);

    unless ($interp) {
        # shouldn't be requesting this without an INTERP header
        die "can't find the interpreter key";
    }

    my $id = $same_interp_id;
    if ($interp eq 'tie') { #first request for an interpreter instance
        # unique id for this instance
        $same_interp_id = $id =
            unpack "H*", pack "Nnn", time, $$, int(rand(60000));
        $same_interp_counter = 0; #reset the counter
    }
    elsif ($interp ne $same_interp_id) {
        # this is not the request interpreter instance
        return Apache2::Const::NOT_FOUND;
    }

    $same_interp_counter++;

    # so client can save the created instance id or check the existing
    # value
    $r->headers_out->set(Apache::TestRequest::INTERP_KEY, $id);

    return Apache2::Const::OK;
}

1;
__END__

=encoding utf8

=head1 NAME

Apache::TestHandler - a few response handlers and helpers

=head1 SYNOPSIS

    package My::Test;
    use Apache::TestHandler ();
    sub handler {
        my ($r) = @_;
        my $result = do_my_test;
        Apache::TestHandler::ok1 $r, $result;
    }

    sub handler2 {
        my ($r) = @_;
        my $result = do_my_test;
        Apache::TestHandler::ok $r, $result;
    }

=head1 DESCRIPTION

C<Apache::TestHandler> provides 2 very simple response handler.

=head1 FUNCTIONS

=over 4

=item ok $r, $boolean

The handler simply prints out C<ok> or C<not ok> depending on the
optional C<$boolean> parameter.

If C<$boolean> is omitted C<true> is assumed.

=item ok1 $r, $boolean

This handler implements a simple response-only test. It can be used on its
own to check if for a certain URI the response phase is reached. Or it
can be called like a normal function to print out the test result. The
client side is automatically created as described in
L<http://perl.apache.org/docs/general/testing/testing.html#Developing_Response_only_Part_of_a_Test>.

C<$boolean> is optional. If omitted C<true> is assumed.

=item same_interp_counter

=item same_interp_fixup

TODO

=back

=head1 SEE ALSO

The Apache-Test tutorial:
L<http://perl.apache.org/docs/general/testing/testing.html>.

L<Apache::Test>.