Request.pm 5.94 KB
Newer Older
1 2 3 4
package Lemonldap::NG::Common::PSGI::Request;

use strict;
use Mouse;
Yadd's avatar
Yadd committed
5
use JSON;
Yadd's avatar
Yadd committed
6
use Plack::Request;
7 8
use URI::Escape;

Yadd's avatar
Yadd committed
9
our $VERSION = '2.0.0';
10

Yadd's avatar
Yadd committed
11 12
our @ISA = ('Plack::Request');

13 14 15
#       http          ://  server   / path      ? query      # fragment
# m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;

Yadd's avatar
Yadd committed
16 17 18
sub BUILD {
    my ( $self, $env ) = @_;
    foreach ( keys %$env ) {
19
        $self->{$_} ||= $env->{$_} if (/^(?:HTTP|SSL)_/);
Yadd's avatar
Yadd committed
20 21 22
    }
}

Yadd's avatar
Yadd committed
23 24 25 26 27 28 29 30 31 32 33 34
sub new {
    my $self = Plack::Request::new(@_);
    my $tmp  = $self->script_name;
    $self->env->{REQUEST_URI} = $self->env->{X_ORIGINAL_URI}
      if ( $self->env->{X_ORIGINAL_URI} );
    $self->env->{PATH_INFO} =~ s|^$tmp|/|;
    $self->env->{PATH_INFO} =~ s|//+|/|g;
    $self->{uri} = uri_unescape( $self->env->{REQUEST_URI} );
    $self->{uri} =~ s|//+|/|g;
    $self->{error}       = 0;
    $self->{respHeaders} = [];
    return $self;
Yadd's avatar
Yadd committed
35 36
}

Yadd's avatar
Yadd committed
37
sub uri { $_[0]->{uri} }
Yadd's avatar
Yadd committed
38

Yadd's avatar
Yadd committed
39
sub userData {
Yadd's avatar
Yadd committed
40 41
    my ( $self, $v ) = @_;
    return $_[0]->{userData} = $v if ($v);
Yadd's avatar
Yadd committed
42
    return $_[0]->{userData} || { _whatToTrace => $_[0]->user, };
43 44
}

Yadd's avatar
Yadd committed
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
sub respHeaders {
    my ( $self, $respHeaders ) = @_;
    $self->{respHeaders} = $respHeaders if ($respHeaders);
    return $self->{respHeaders};
}

sub accept        { $_[0]->env->{HTTP_ACCEPT} }
sub encodings     { $_[0]->env->{HTTP_ACCEPT_ENCODING} }
sub languages     { $_[0]->env->{HTTP_ACCEPT_LANGUAGE} }
sub authorization { $_[0]->env->{HTTP_AUTHORIZATION} }
sub hostname      { $_[0]->env->{HTTP_HOST} }
sub referer       { $_[0]->env->{REFERER} }

sub error {
    my ( $self, $err ) = @_;
    $self->{error} = $err if ($err);
    return $self->{error};
}

*params = \&Plack::Request::param;

sub set_param {
    my ( $self, $k, $v ) = @_;
    $self->param;
    $self->env->{'plack.request.merged'}->{$k} =
      $self->env->{'plack.request.query'}->{$k} = $v;
}
Yadd's avatar
Yadd committed
72

Yadd's avatar
Yadd committed
73
sub wantJSON {
74 75 76 77
    return 1
      if ( defined $_[0]->accept
        and $_[0]->accept =~ m#(?:application|text)/json# );
    return 0;
Yadd's avatar
Yadd committed
78 79
}

80 81 82
# JSON parser
sub jsonBodyToObj {
    my $self = shift;
Yadd's avatar
Yadd committed
83 84
    return $self->{json_body} if ( $self->{json_body} );
    unless ( $self->content_type =~ /application\/json/ ) {
85 86 87 88 89 90 91
        $self->error('Data is not JSON');
        return undef;
    }
    unless ( $self->body ) {
        $self->error('No data');
        return undef;
    }
92
    my $j = eval { from_json( $self->content ) };
93
    if ($@) {
94 95 96
        $self->error("$@$!");
        return undef;
    }
Yadd's avatar
Yadd committed
97
    return $self->{json_body} = $j;
Yadd's avatar
Yadd committed
98 99
}

100
1;
Yadd's avatar
Yadd committed
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
__END__

=head1 NAME

=encoding utf8

Lemonldap::NG::Common::PSGI::Request - HTTP request object for Lemonldap::NG
PSGIs

=head1 SYNOPSIS

  package My::PSGI;
  
  use base Lemonldap::NG::Common::PSGI;
  
  # See Lemonldap::NG::Common::PSGI
  ...
  
119
  sub handler {
Yadd's avatar
Yadd committed
120
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
121 122 123 124 125 126 127 128 129 130
    # Do something and return a PSGI response
    # NB: $req is a Lemonldap::NG::Common::PSGI::Request object
    if ( $req->accept eq 'text/plain' ) { ... }
    
    return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Body lines' ] ];
  }

=head1 DESCRIPTION

This package provides HTTP request objects used by Lemonldap::NG PSGIs. It
Yadd's avatar
Yadd committed
131 132
contains common accessors to work with request. Note that it inherits from
L<Plack::Request>.
Yadd's avatar
Yadd committed
133 134 135

=head1 METHODS

Yadd's avatar
Yadd committed
136 137
All methods of L<Plack::Request> are available.
Lemonldap::NG::Common::PSGI::Request adds the following methods:
Yadd's avatar
Yadd committed
138

Yadd's avatar
Yadd committed
139
=head2 accept
Yadd's avatar
Yadd committed
140 141 142

'Accept' header content.

Yadd's avatar
Yadd committed
143
=head2 encodings
Yadd's avatar
Yadd committed
144 145 146

'Accept-Encoding' header content.

Yadd's avatar
Yadd committed
147
=head2 error
Yadd's avatar
Yadd committed
148

Yadd's avatar
Yadd committed
149 150
Used to store error value (usually a L<Lemonldap::NG::Portal::Main::Constants>
constant).
Yadd's avatar
Yadd committed
151

Yadd's avatar
Yadd committed
152
=head2 jsonBodyToObj
Yadd's avatar
Yadd committed
153

Yadd's avatar
Yadd committed
154
Get the content of a JSON POST request as Perl object.
Yadd's avatar
Yadd committed
155

Yadd's avatar
Yadd committed
156
=head2 languages
Yadd's avatar
Yadd committed
157

Yadd's avatar
Yadd committed
158
'Accept-Language header content.
Yadd's avatar
Yadd committed
159

Yadd's avatar
Yadd committed
160
=head2 hostname
Yadd's avatar
Yadd committed
161

Yadd's avatar
Yadd committed
162
'Host' header content.
Yadd's avatar
Yadd committed
163

Yadd's avatar
Yadd committed
164
=head2 read-body
Yadd's avatar
Yadd committed
165

Yadd's avatar
Yadd committed
166 167
Since body() methods returns an L<IO::Handle> object, this method reads and
return the request content as string.
Yadd's avatar
Yadd committed
168

Yadd's avatar
Yadd committed
169
=head2 respHeaders
Yadd's avatar
Yadd committed
170

Yadd's avatar
Yadd committed
171 172
Accessor to 'respHeaders' property. It is used to store headers that have to
be pushed in response (see L<Lemonldap::NG::Common::PSGI>).
Yadd's avatar
Yadd committed
173

Yadd's avatar
Yadd committed
174 175
Be careful, it contains an array reference, not a hash one because headers
can be multi-valued.
Yadd's avatar
Yadd committed
176 177 178

Exemple:

Yadd's avatar
Yadd committed
179
  # Set headers
Yadd's avatar
Yadd committed
180
  $req->respHeaders( "Location" => "http://x.y.z/", Etag => "XYZ", );
Yadd's avatar
Yadd committed
181 182
  # Add header
  $req->respHeaders->{"X-Key"} = "Value"; 
Yadd's avatar
Yadd committed
183

Yadd's avatar
Yadd committed
184
=head2 set_param( $key, $value )
Yadd's avatar
Yadd committed
185

Yadd's avatar
Yadd committed
186 187
L<Plack::Request> param() method is read-only. This method can be used to
modify a GET parameter value
Yadd's avatar
Yadd committed
188

Yadd's avatar
Yadd committed
189
=head2 uri
Yadd's avatar
Yadd committed
190

Yadd's avatar
Yadd committed
191
REQUEST_URI environment variable decoded.
Yadd's avatar
Yadd committed
192

Yadd's avatar
Yadd committed
193
=head2 user
Yadd's avatar
Yadd committed
194

Yadd's avatar
Yadd committed
195 196
REMOTE_USER environment variable. It contains username when a server
authentication is done.
Yadd's avatar
Yadd committed
197

Yadd's avatar
Yadd committed
198
=head2 userData
Yadd's avatar
Yadd committed
199

Yadd's avatar
Yadd committed
200 201 202
Hash reference to the session information (if app inherits from
L<Lemonldap::NG::Handler::PSGI> or any other handler PSGI package). If no
session information is available, it contains:
Yadd's avatar
Yadd committed
203

Yadd's avatar
Yadd committed
204
  { _whatToTrace => <REMOTE-USER value> }
Yadd's avatar
Yadd committed
205

Yadd's avatar
Yadd committed
206
=head2 wantJSON
Yadd's avatar
Yadd committed
207 208 209 210

Return true if current request ask JSON content (verify that "Accept" header
contains "application/json" or "text/json").

Yadd's avatar
Yadd committed
211 212
=head1 SEE ALSO

Yadd's avatar
Yadd committed
213 214 215
L<http://lemonldap-ng.org/>, L<Lemonldap::NG::Common::PSGI>,
L<Lemonldap::NG::Hander::PSGI>, L<Plack::Request>,
L<Lemonldap::NG::Portal::Main::Constants>, 
Yadd's avatar
Yadd committed
216 217 218 219 220

=head1 AUTHORS

=over

Yadd's avatar
Yadd committed
221
=item LemonLDAP::NG team L<http://lemonldap-ng.org/team>
Yadd's avatar
Yadd committed
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236

=back

=head1 BUG REPORT

Use OW2 system to report bug or ask for features:
L<http://jira.ow2.org>

=head1 DOWNLOAD

Lemonldap::NG is available at
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>

=head1 COPYRIGHT AND LICENSE

Yadd's avatar
Yadd committed
237
See COPYING file for details.
Yadd's avatar
Yadd committed
238 239 240 241 242 243 244 245 246 247 248 249 250 251 252

This library is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see L<http://www.gnu.org/licenses/>.

=cut