view release on metacpan or  search on metacpan

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

    # httpd (1.3 && 2) / winFU have problems when the first path's
    # segment includes ':' (security precaution which breaks the rfc)
    # so we can't use /TestFoo::bar as path_info
    (my $path = $package) =~ s/::/__/g;

    return $path;
}

sub module2url {
    my $module   = shift;
    my $opt      = shift || {};
    my $scheme   = $opt->{scheme} || 'http';
    my $path     = exists $opt->{path} ? $opt->{path} : module2path($module);

    module($module);

    my $config   = Apache::Test::config();
    my $hostport = hostport($config);

    $path =~ s|^/||;
    return "$scheme://$hostport/$path";
}

sub user_agent {
    my $args = {@_};

    if (delete $args->{reset}) {
        $UA = undef;
    }

    if (exists $args->{requests_redirectable}) {
        my $redir = $args->{requests_redirectable};
        if (ref $redir and (@$redir > 1 or $redir->[0] ne 'POST')) {
            # Set our internal flag if there's no LWP.
            $REDIR = $have_lwp ? undef : 1;
        } elsif ($redir) {
            if ($have_lwp) {
                $args->{requests_redirectable} = [ qw/GET HEAD POST/ ];
                $REDIR = undef;
            } else {
                # Set our internal flag.
                $REDIR = 1;
            }
        } else {
            # Make sure our internal flag is false if there's no LWP.
            $REDIR = $have_lwp ? undef : 0;
        }
    }

    $args->{keep_alive} ||= $ENV{APACHE_TEST_HTTP11};

    if ($args->{keep_alive}) {
        install_http11();
        eval {
            require LWP::Protocol::https; #https10 is the default
            LWP::Protocol::implementor('https', 'LWP::Protocol::https');
        };
    }

    # in LWP 6, verify_hostname defaults to on, so SSL_ca_file
    # needs to be set accordingly
    if ($have_lwp and $LWP::VERSION >= 6.0 and not exists $args->{ssl_opts}->{SSL_ca_file}) {
        my $vars = Apache::Test::vars();
        my $cafile = "$vars->{sslca}/$vars->{sslcaorg}/certs/ca.crt";
        $args->{ssl_opts}->{SSL_ca_file} = $cafile;
        # IO::Socket:SSL raw socket compatibility
        $conn_opts->{SSL_ca_file} = $cafile;
    }

    eval { $UA ||= __PACKAGE__->new(%$args); };
}

sub user_agent_request_num {
    my $res = shift;
    $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;

    my $default_hostport = join ':', $vars->{servername}, $vars->{port};
    if (my $module = $Apache::TestRequest::Module) {
        $hostport = $module eq 'default'
            ? $default_hostport
            : $config->{vhosts}->{$module}->{hostport};
    }

    $hostport || $default_hostport;
}

sub resolve_url {
    my $url = shift;
    Carp::croak("no url passed") unless defined $url;

    return $url if $url =~ m,^(\w+):/,;
    $url = "/$url" unless $url =~ m,^/,;

    my $vars = Apache::Test::vars();

    local $vars->{scheme} =
      $Apache::TestRequest::Scheme || $vars->{scheme} || 'http';

    scheme_fixup($vars->{scheme});