view release on metacpan or  search on metacpan

lib/Test/CGI/External.pm  view on Meta::CPAN

# Fail a test which means that we cannot keep going.

sub abort_test
{
    my ($self, $test) = @_;
    $self->{tb}->skip_all ($test);
}

# Set an environment variable, with warning about collisions.

sub setenv_private
{
    my ($self, $name, $value) = @_;
    if (! $self->{set_env}) {
        $self->{set_env} = [$name];
    }
    else {
        push @{$self->{set_env}}, $name;
    }
    if ($ENV{$name}) {
	if (! $self->{no_warn}) {

lib/Test/CGI/External.pm  view on Meta::CPAN

    my $verbose = $self->{verbose};
    my $options = $self->{run_options};
    my $cgi_executable = $self->{cgi_executable};
    my $comp_test = $self->{comp_test};

    # Hassle up the CGI inputs, including environment variables, from
    # the options the user has given.

    # mwforum requires GATEWAY_INTERFACE to be set to CGI/1.1
    #    setenv_private ($o, 'GATEWAY_INTERFACE', 'CGI/1.1');

    my $query_string = $options->{QUERY_STRING};
    if (defined $query_string) {
	$self->note ("I am setting the query string to '$query_string'.");
        setenv_private ($self, 'QUERY_STRING', $query_string);
    }
    else {
	$self->note ("There is no query string.");
        setenv_private ($self, 'QUERY_STRING', "");
    }

    my $request_method;
    if ($options->{no_check_request_method}) {
	$request_method = $options->{REQUEST_METHOD};
    }
    else {
	$request_method = $self->check_request_method ($options->{REQUEST_METHOD});
    }
    $self->note ("The request method is '$request_method'.");
    setenv_private ($self, 'REQUEST_METHOD', $request_method);
    my $content_type = $options->{CONTENT_TYPE};
    if ($content_type) {
	$self->note ("The content type is '$content_type'.");
	setenv_private ($self, 'CONTENT_TYPE', $content_type);
    }
    if ($options->{HTTP_COOKIE}) {
        setenv_private ($self, 'HTTP_COOKIE', $options->{HTTP_COOKIE});
    }
    my $remote_addr = $self->{run_options}->{REMOTE_ADDR};
    if ($remote_addr) {
	$self->note ("I am setting the remote address to '$remote_addr'.");
        setenv_private ($self, 'REMOTE_ADDR', $remote_addr);
    }
    if (defined $options->{input}) {
        $self->{input} = $options->{input};
	if (utf8::is_utf8 ($self->{input})) {
	    $self->{input} = $self->encode_utf8_safe ();
	}
	if ($self->{bad_content_length}) {
	    setenv_private ($self, 'CONTENT_LENGTH', '0');
	}
	else {
	    my $content_length = length ($self->{input});
	    setenv_private ($self, 'CONTENT_LENGTH', $content_length);
	    $self->note ("I am setting the CGI program's standard input to a string of length $content_length taken from the input options.");
	    $options->{content_length} = $content_length;
	}
    }

    if ($comp_test) {
        if ($verbose) {
	    $self->{tb}->note ("I am requesting gzip encoding from the CGI executable.\n");
        }
        setenv_private ($self, 'HTTP_ACCEPT_ENCODING', 'gzip, fake');
    }

    # Actually run the executable under the current circumstances.

    my @cmd = ($cgi_executable);
    if ($self->{command_line_options}) {
	push @cmd, @{$self->{command_line_options}};
    }
    $self->note ("I am running '@cmd'");
    $self->run3 (\@cmd);