view release on metacpan or  search on metacpan

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

sub getline {
    my $sock = shift;
    my $class = ref $sock;
    my $method = $getline{$class} || 'getline';
    $sock->$method();
}

sub socket_trace {
    my $sock = shift;
    return unless $sock->can('get_peer_certificate');

    #like having some -v info
    my $cert = $sock->get_peer_certificate;
    print "#Cipher:  ", $sock->get_cipher, "\n";
    print "#Peer DN: ", $cert->subject_name, "\n";
}

sub prepare {
    my $url = shift;

    if ($have_lwp) {
        user_agent();
        $url = resolve_url($url);
    }
    else {
        lwp_debug() if $ENV{APACHE_TEST_DEBUG_LWP};
    }

    my($pass, $keep) = Apache::TestConfig::filter_args(\@_, \%wanted_args);

    %credentials = ();
    if (defined $keep->{username}) {
        $credentials{$keep->{realm} || '__ALL__'} =
          [$keep->{username}, $keep->{password}];
    }
    if (defined(my $content = $keep->{content})) {
        if ($content eq '-') {
            $content = join '', <STDIN>;
        }
        elsif ($content =~ /^x(\d+)$/) {
            $content = 'a' x $1;
        }
        push @$pass, content => $content;
    }
    if (exists $keep->{cert}) {
        set_client_cert($keep->{cert});
    }

    return ($url, $pass, $keep);
}

sub UPLOAD {
    my($url, $pass, $keep) = prepare(@_);

    local $RedirectOK = exists $keep->{redirect_ok}
        ? $keep->{redirect_ok}
        : $RedirectOK;

    if ($keep->{filename}) {
        return upload_file($url, $keep->{filename}, $pass);
    }
    else {
        return upload_string($url, $keep->{content});
    }
}

sub UPLOAD_BODY {
    UPLOAD(@_)->content;
}

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;
    $r->content($content); #reset
    $string;
}

$DebugLWP = 0; #1 == print METHOD URL and header response for all requests
               #2 == #1 + response body
               #other == passed to LWP::Debug->import

sub lwp_debug {
    package main; #wtf: else package in perldb changes
    my $val = $_[0] || $ENV{APACHE_TEST_DEBUG_LWP};

    return unless $val;

    if ($val =~ /^\d+$/) {
        $Apache::TestRequest::DebugLWP = $val;
        return "\$Apache::TestRequest::DebugLWP = $val\n";
    }
    else {
        my(@args) = @_ ? @_ : split /\s+/, $val;
        require LWP::Debug;
        LWP::Debug->import(@args);
        return "LWP::Debug->import(@args)\n";
    }
}

sub lwp_trace {
    my $r = shift;

    unless ($r->request->protocol) {
        #lwp always sends a request, but never sets
        #$r->request->protocol, happens deeper in the
        #LWP::Protocol::http* modules
        my $proto = user_agent_request_num($r) ? "1.1" : "1.0";

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

representation will consist solely of the headers. Furthermore,
C<GET_HEAD> inserts a "#" at the beginning of each line of the return
string, so that the contents are suitable for printing to STDERR
during your tests without interfering with the workings of
C<Test::Harness>.

=head3 PUT

  my $res = PUT $uri;

Sends a simple PUT request to the Apache test server. Returns an
C<HTTP::Response> object.

=head3 PUT_STR

A shortcut function for C<PUT($uri)-E<gt>as_string>.

=head3 PUT_BODY

A shortcut function for C<PUT($uri)-E<gt>content>.

=head3 PUT_BODY_ASSERT

Use this function when your test is outputting content that you need
to check, and you want to make sure that the request was successful
before comparing the contents of the request. If the request was
unsuccessful, C<PUT_BODY_ASSERT> will return an error
message. Otherwise it will simply return the content of the request
just as C<PUT_BODY> would.

=head3 PUT_OK

A shortcut function for C<PUT($uri)-E<gt>is_success>.

=head3 PUT_RC

A shortcut function for C<PUT($uri)-E<gt>code>.

=head3 PUT_HEAD

Throws out the content of the request, and returns the string
representation of the request. Since the body has been thrown out, the
representation will consist solely of the headers. Furthermore,
C<PUT_HEAD> inserts a "#" at the beginning of each line of the return
string, so that the contents are suitable for printing to STDERR
during your tests without interfering with the workings of
C<Test::Harness>.

=head3 POST

  my $res = POST $uri, [ arg => $val, arg2 => $val ];

Sends a POST request to the Apache test server and returns an
C<HTTP::Response> object. An array reference of parameters passed as
the second argument will be submitted to the Apache test server as the
POST content. Parameters corresponding to those documented in
L<Optional Parameters|/Optional
Parameters> can follow the optional array reference of parameters, or after
C<$uri>.

To upload a chunk of data, simply use:

  my $res = POST $uri, content => $data;

=head3 POST_STR

A shortcut function for C<POST($uri, @args)-E<gt>content>.

=head3 POST_BODY

A shortcut function for C<POST($uri, @args)-E<gt>content>.

=head3 POST_BODY_ASSERT

Use this function when your test is outputting content that you need
to check, and you want to make sure that the request was successful
before comparing the contents of the request. If the request was
unsuccessful, C<POST_BODY_ASSERT> will return an error
message. Otherwise it will simply return the content of the request
just as C<POST_BODY> would.

=head3 POST_OK

A shortcut function for C<POST($uri, @args)-E<gt>is_success>.

=head3 POST_RC

A shortcut function for C<POST($uri, @args)-E<gt>code>.

=head3 POST_HEAD

Throws out the content of the request, and returns the string
representation of the request. Since the body has been thrown out, the
representation will consist solely of the headers. Furthermore,
C<POST_HEAD> inserts a "#" at the beginning of each line of the return
string, so that the contents are suitable for printing to STDERR
during your tests without interfering with the workings of
C<Test::Harness>.

=head3 UPLOAD

  my $res = UPLOAD $uri, \@args, filename => $filename;

Sends a request to the Apache test server that includes an uploaded
file. Other POST parameters can be passed as a second argument as an
array reference.

C<Apache::TestRequest> will read in the contents of the file named via
the C<filename> parameter for submission to the server. If you'd
rather, you can submit use the C<content> parameter instead of
C<filename>, and its value will be submitted to the Apache server as
file contents:

  my $res = UPLOAD $uri, undef, content => "This is file content";

The name of the file sent to the server will simply be "b". Note that
in this case, you cannot pass other POST arguments to C<UPLOAD()> --
they would be ignored.

=head3 UPLOAD_BODY

A shortcut function for C<UPLOAD($uri, @params)-E<gt>content>.

=head3 UPLOAD_BODY_ASSERT

Use this function when your test is outputting content that you need
to check, and you want to make sure that the request was successful
before comparing the contents of the request. If the request was
unsuccessful, C<UPLOAD_BODY_ASSERT> will return an error
message. Otherwise it will simply return the content of the request
just as C<UPLOAD_BODY> would.

=head3 OPTIONS

  my $res = OPTIONS $uri;

Sends an C<OPTIONS> request to the Apache test server. Returns an
C<HTTP::Response> object with the I<Allow> header, indicating which
methods the server supports. Possible methods include C<OPTIONS>,
C<GET>, C<HEAD> and C<POST>. This function thus can be useful for
testing what options the Apache server supports. Consult the HTTPD 1.1
specification, section 9.2, at
I<http://www.faqs.org/rfcs/rfc2616.html> for more information.





=head2 URL Manipulation Functions

C<Apache::TestRequest> also includes a few helper functions to aid in
the creation of urls used in the functions above.



=head3 C<module2path>

  $path = Apache::TestRequest::module2path($module_name);

Convert a module name to a path, safe for use in the various request
methods above. e.g. C<::> can't be used in URLs on win32. For example:

  $path = Apache::TestRequest::module2path('Foo::Bar');