lib/Net/HTTP/Spore/Request.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155

package Net::HTTP::Spore::Request;

use strict;
use warnings;

use URI;
use HTTP::Headers;
use HTTP::Request;
use URI::Escape;
use Hash::MultiValue;

use Net::HTTP::Spore::Response;

sub new {
    my ( $class, $env ) = @_;
    bless { env => $env }, $class;
}

sub env         { $_[0]->{env}; }
sub method      { $_[0]->{env}->{REQUEST_METHOD} }
sub port        { $_[0]->{env}->{SERVER_PORT} }
sub script_name { $_[0]->{env}->{SCRIPT_NAME} }
sub path        { $_[0]->{env}->{PATH_INFO} || '/' }
sub request_uri { $_[0]->{env}->{REQUEST_URI} }
sub protocol    { $_[0]->{env}->{SERVER_PROTOCOL} }
sub content     { $_[0]->{env}->{'spore.payload'} }
sub scheme      { $_[0]->{env}->{'spore.scheme'} }

sub path_info {
    my $self = shift;
    my ($path) = $self->_path;
    $path;
}

sub _path {
    my $self = shift;

    my $query_string;
    my $path = $self->env->{PATH_INFO};
    my @params = @{ $self->env->{'spore.params'} || [] };

    my $j = 0;
    for (my $i = 0; $i < scalar @params; $i++) {
        my $key = $params[$i];
        my $value = $params[++$i];
        if (!$value) {
            $query_string .= $key;
            last;
        }
        unless ( $path && $path =~ s/\:$key/$value/ ) {
            $query_string .= $key . '=' . $value;
            $query_string .= '&' if $query_string && scalar @params;
        }
    }

    $query_string =~ s/&$// if $query_string;
    return ( $path, $query_string );
}

sub query_string {
    my $self = shift;
    my ( undef, $query_string ) = $self->_path;
    $query_string;
}

sub headers {
    my $self = shift;
    if ( !defined $self->{headers} ) {
        my $env = $self->env;
        $self->{headers} = HTTP::Headers->new(
            map {
                ( my $field = $_ ) =~ s/^HTTPS?_//;
                ( $field => $env->{$_} );
              } grep { /^(?:HTTP|CONTENT)/i } keys %$env
        );
    }
    $self->{headers};
}

sub header {shift->headers->header(@_)}

sub uri {
    my $self = shift;

    my $path_info    = shift;
    my $query_string = shift;

    if ( !defined $path_info || !defined $query_string ) {
        my @path_info = $self->_path;
        $path_info    = $path_info[0] if !$path_info;
        $query_string = $path_info[1] if !$query_string;
    }

    my $base = $self->_uri_base;

    my $path_escape_class = '^A-Za-z0-9\-\._~/';

    my $path = URI::Escape::uri_escape($path_info || '', $path_escape_class);

    if ($query_string) {
        $path .= '?' . $query_string;
    }

    $base =~ s!/$!! if $path =~ m!^/!;
    return URI->new( $base . $path )->canonical;
}

sub query_parameters {
    my $self = shift;
}

sub base {
    my $self = shift;
    URI->new( $self->_uri_base )->canonical;
}

sub _uri_base {
    my $self = shift;
    my $env  = $self->env;

    my $uri =
      ( $env->{'spore.url_scheme'} || "http" ) . "://"
      . (
        $env->{HTTP_HOST}
          || (( $env->{SERVER_NAME} || "" ) . ":"
            . ( $env->{SERVER_PORT} || 80 ) )
      ) . ( $env->{SCRIPT_NAME} || '/' );
    return $uri;
}

sub new_response {
    my $self = shift;
    my $res = Net::HTTP::Spore::Response->new(@_);
    $res->request($self);
    $res;
}

sub finalize {
    my $self = shift;

    my ($path_info, $query_string) = $self->_path;

    $self->env->{PATH_INFO} = $path_info;
    $self->env->{QUERY_STRING} = $query_string || '';

    my $uri = $self->uri($path_info, $query_string || '');

    my $request =
      HTTP::Request->new( $self->method => $uri, $self->headers );

    $request->content($self->content) if ($self->content);
    $request;
}

1;