view release on metacpan or  search on metacpan

lib/Dancer/Test.pm  view on Meta::CPAN

                || 'text/plain';

            # coerce hashref into an url-encoded string
            if ( ref($content) && ( ref($content) eq 'HASH' ) ) {
                my @tokens;
                while ( my ( $name, $value ) = each %{$content} ) {
                    $name  = _url_encode($name);
                    my @values = ref $value eq 'ARRAY' ? @$value : ($value);
                    for my $value (@values) {
                        $value = _url_encode($value);
                        push @tokens, "${name}=${value}";
                    }
                }
                $content = join( '&', @tokens );
                $content_type = 'application/x-www-form-urlencoded';
            }
        }
        elsif ( $args->{files} ) {
            $content_type = 'multipart/form-data; boundary=----BOUNDARY';
            foreach my $file (@{$args->{files}}){
                $file->{content_type} ||= 'text/plain';
                $content .= qq/------BOUNDARY\r\n/;
                $content .= qq/Content-Disposition: form-data; name="$file->{name}"; filename="$file->{filename}"\r\n/;
                $content .= qq/Content-Type: $file->{content_type}\r\n\r\n/;
                if ( $file->{data} ) {
                    $content .= $file->{data};
                } else {
                    open my $fh, '<', $file->{filename}
                        or die "Failed to open $file->{filename} - $!";
                    if ( -B $file->{filename} ) {
                        binmode $fh;
                    }
                    while (<$fh>) {
                        $content .= $_;
                    }
                }
                $content .= "\r\n";
            }
            $content .= "------BOUNDARY";
        }

        my $l = 0;
        $l = length $content if defined $content;
        open my $in, '<', \$content;
        $extra_env->{'CONTENT_LENGTH'} = $l;
        $extra_env->{'CONTENT_TYPE'}   = $content_type || "";
        $extra_env->{'psgi.input'}     = $in;
    }

    my ($params, $body, $headers) = @$args{qw(params body headers)};

    $headers = HTTP::Headers->new(@{$headers||[]})
        unless _isa($headers, "HTTP::Headers");

    if ($headers->header('Content-Type')) {
        $extra_env->{'CONTENT_TYPE'} = $headers->header('Content-Type');
    }

    # handle all the keys of Request::_build_request_env():
    for my $key (qw( user_agent host accept_language accept_charset
        accept_encoding keep_alive connection accept accept_type referer
        x_requested_with )) {
        my $k = sprintf("HTTP_%s", uc $key);
        $extra_env->{$k} = $headers->{$key}
            if exists $headers->{$key};
    }

    # fake the REQUEST_URI
    # TODO deal with the params
    unless( $extra_env->{REQUEST_URI} ) {
        $extra_env->{REQUEST_URI} = $path;
        if ( $method eq 'GET' and $params ) {
            $extra_env->{REQUEST_URI} .=
                '?' . join '&', map { join '=', $_, $params->{$_} } 
                                    sort keys %$params;
        }
    }

    my $request = Dancer::Request->new_for_request(
        $method => $path,
        $params, $body, $headers, $extra_env
    );

    # first, reset the current state
    Dancer::SharedData->reset_all();

    # then store the request
    Dancer::SharedData->request($request);

    # XXX this is a hack!!
    $request = Dancer::Serializer->process_request($request)
      if Dancer::App->current->setting('serializer');

    my $get_action = Dancer::Handler::render_request($request);
    my $response = Dancer::SharedData->response();

    $response->content('') if $method eq 'HEAD';
    Dancer::SharedData->reset_response();
    return $response if $get_action;
    (defined $response && $response->exists) ? return $response : return undef;
}

# private

sub _url_encode {
    my $string = shift;
    $string =~ s/([\W])/"%" . uc(sprintf("%2.2x",ord($1)))/eg;
    return $string;
}

sub _get_file_response {
    my ($req) = @_;

    my ($method, $path, $params) = expand_req($req);
    my $request = Dancer::Request->new_for_request($method => $path, $params);
    Dancer::SharedData->request($request);
    return Dancer::Renderer::get_file_response();
}

sub _get_handler_response {
    my ($req) = @_;