Apache-Test

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

add Apache-TestItSelf and Apache-TestMe sub-projects. [Stas]

add various straps to aid the new Apache-TestItSelf sub-project, which
is used to test A-T config options [Stas]

avoid entering endless loops when interactive config is used, by
restarting the test suite with an explicit selected arguments for
-httpd (and optionally -apxs) [Stas]

META.yml is now locally maintained. we need to tell PAUSE indexer not
to try to index HTTP::Request::Common and warnings packages, which
happen to be used by A-T [Stas]



=item 1.17 - December 11, 2004

Apache::TestHandler: need to load Apache::RequestIO for mp2 for puts()
to work [Stas]

new Apache::TestConfig wrapper untaint_path() [Randy Kobes]

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

sub lwp_init {
    use vars qw($UA $Location);
    $UA = Apache::TestRequest::user_agent();
    $Location = shift;
}

sub lwp_do {
    my $length = shift;

    my $request = HTTP::Request->new(POST => $Location);
    $request->header('Content-length' => $length);

    if (LWP->VERSION >= 5.800) {
        $request->content_ref(\('a' x $length));
    } else {
        # before LWP 5.800 there was no way to tell HTTP::Message not
        # to copy the string, there is a settable content_ref since
        # 5.800
        use constant BUF_SIZE => 8192;

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

use constant UA_TIMEOUT => 60 * 10; #longer timeout for debugging

my $have_lwp = 0;

# APACHE_TEST_PRETEND_NO_LWP=1 pretends that LWP is not available so
# one can test whether the test suite survives if the user doesn't
# have lwp installed
unless ($ENV{APACHE_TEST_PRETEND_NO_LWP}) {
    $have_lwp = eval {
        require LWP::UserAgent;
        require HTTP::Request::Common;

        unless (defined &HTTP::Request::Common::OPTIONS) {
            package HTTP::Request::Common;
            no strict 'vars';
            *OPTIONS = sub { _simple_req(OPTIONS => @_) };
            push @EXPORT, 'OPTIONS';
        }
        1;
    };
}

unless ($have_lwp) {
    require Apache::TestClient;
}

sub has_lwp { $have_lwp }

unless ($have_lwp) {
    #need to define the shortcuts even though the wont be used
    #so Perl can parse test scripts
    @HTTP::Request::Common::EXPORT = qw(GET HEAD POST PUT OPTIONS);
}

sub install_http11 {
    eval {
        die "no LWP" unless $have_lwp;
        LWP->VERSION(5.60); #minimal version
        require LWP::Protocol::http;
        #LWP::Protocol::http10 is used by default
        LWP::Protocol::implementor('http', 'LWP::Protocol::http');
    };
}

use vars qw(@EXPORT @ISA $RedirectOK $DebugLWP);

require Exporter;
*import = \&Exporter::import;
@EXPORT = @HTTP::Request::Common::EXPORT;

@ISA = qw(LWP::UserAgent);

my $UA;
my $REDIR = $have_lwp ? undef : 1;
my $conn_opts = {};

sub module {
    my $module = shift;
    $Apache::TestRequest::Module = $module if $module;

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

    $res->header('Client-Request-Num') ||  #lwp 5.60
        $res->header('Client-Response-Num'); #lwp 5.62+
}

sub user_agent_keepalive {
    $ENV{APACHE_TEST_HTTP11} = shift;
}

sub do_request {
    my($ua, $method, $url, $callback) = @_;
    my $r = HTTP::Request->new($method, resolve_url($url));
    my $response = $ua->request($r, $callback);
    lwp_trace($response);
}

sub hostport {
    my $config = shift || Apache::Test::config();
    my $vars = $config->{vars};
    local $vars->{scheme} =
        $Apache::TestRequest::Scheme || $vars->{scheme};
    my $hostport = $config->hostport;

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

sub UPLOAD_BODY_ASSERT {
    content_assert(UPLOAD(@_));
}

#lwp only supports files
sub upload_string {
    my($url, $data) = @_;

    my $CRLF = "\015\012";
    my $bound = 742617000027;
    my $req = HTTP::Request->new(POST => $url);

    my $content = join $CRLF,
      "--$bound",
      "Content-Disposition: form-data; name=\"HTTPUPLOAD\"; filename=\"b\"",
      "Content-Type: text/plain", "",
      $data, "--$bound--", "";

    $req->header("Content-Length", length($content));
    $req->content_type("multipart/form-data; boundary=$bound");
    $req->content($content);

    $UA->request($req);
}

sub upload_file {
    my($url, $file, $args) = @_;

    my $content = [@$args, filename => [$file]];

    $UA->request(HTTP::Request::Common::POST($url,
                 Content_Type => 'form-data',
                 Content      => $content,
    ));
}

#useful for POST_HEAD and $DebugLWP (see below)
sub lwp_as_string {
    my($r, $want_body) = @_;
    my $content = $r->content;

    unless ($r->isa('HTTP::Request') or
            $r->header('Content-Length') or
            $r->header('Transfer-Encoding'))
    {
        $r->header('Content-Length' => length $content);
        $r->header('X-Content-length-note' => 'added by Apache::TestRequest');
    }

    $r->content('') unless $want_body;

    (my $string = $r->as_string) =~ s/^/\#/mg;

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

my %shortcuts = (RC   => sub { shift->code },
                 OK   => sub { shift->is_success },
                 STR  => sub { shift->as_string },
                 HEAD => sub { lwp_as_string(shift, 0) },
                 BODY => sub { shift->content },
                 BODY_ASSERT => sub { content_assert(shift) },
);

for my $name (@EXPORT) {
    my $package = $have_lwp ?
      'HTTP::Request::Common': 'Apache::TestClient';

    my $method = join '::', $package, $name;
    no strict 'refs';

    next unless defined &$method;

    *$name = sub {
        my($url, $pass, $keep) = prepare(@_);
        local $RedirectOK = exists $keep->{redirect_ok}
            ? $keep->{redirect_ok}

t/request.t  view on Meta::CPAN

ok HEAD_RC  $url;
ok HEAD_STR $url;

ok GET_OK   $url, username => 'dougm', password => 'XXXX'; #e.g. for auth

ok GET_OK   $url, Referer => $0;   #add headers

#post a string
#ok POST_OK  $url, content => 'post body data';

#or key/value pairs (see HTTP::Request::Common
#ok POST_OK  $url, [university => 'arizona', team => 'wildcats']