/lib/HTTP/Engine/Request.pm
Perl | 626 lines | 461 code | 153 blank | 12 comment | 46 complexity | 816d20c022c9d992b830f2762572b23b MD5 | raw file
1package HTTP::Engine::Request; 2use Any::Moose; 3use HTTP::Headers::Fast; 4use HTTP::Engine::Types::Core qw( Uri Header ); 5use URI::QueryParam; 6require Carp; # Carp->import is too heavy =( 7 8# Mouse, Moose role merging is borked with attributes 9#with qw(HTTP::Engine::Request); 10 11# this object constructs all our lazy fields for us 12has request_builder => ( 13 does => "HTTP::Engine::Role::RequestBuilder", 14 is => "rw", 15 required => 1, 16); 17 18sub BUILD { 19 my ( $self, $param ) = @_; 20 21 foreach my $field (qw/base path/) { 22 if ( my $val = $param->{$field} ) { 23 $self->$field($val); 24 } 25 } 26} 27 28has _connection => ( 29 is => "ro", 30 isa => 'HashRef', 31 required => 1, 32); 33 34has "_read_state" => ( 35 is => "rw", 36 lazy_build => 1, 37); 38 39sub _build__read_state { 40 my $self = shift; 41 $self->request_builder->_build_read_state($self); 42} 43 44has connection_info => ( 45 is => "rw", 46 isa => "HashRef", 47 lazy_build => 1, 48); 49 50sub _build_connection_info { 51 my $self = shift; 52 $self->request_builder->_build_connection_info($self); 53} 54 55has cookies => ( 56 is => 'rw', 57 isa => 'HashRef', 58 lazy_build => 1, 59); 60 61sub _build_cookies { 62 my $self = shift; 63 $self->request_builder->_build_cookies($self); 64} 65 66foreach my $attr (qw/address method protocol user port _https_info request_uri/) { 67 has $attr => ( 68 is => 'rw', 69 # isa => "Str", 70 lazy => 1, 71 default => sub { shift->connection_info->{$attr} }, 72 ); 73} 74has query_parameters => ( 75 is => 'rw', 76 isa => 'HashRef', 77 lazy_build => 1, 78); 79 80sub _build_query_parameters { 81 my $self = shift; 82 $self->uri->query_form_hash; 83} 84 85# https or not? 86has secure => ( 87 is => 'rw', 88 isa => 'Bool', 89 lazy_build => 1, 90); 91 92sub _build_secure { 93 my $self = shift; 94 95 if ( my $https = $self->_https_info ) { 96 return 1 if uc($https) eq 'ON'; 97 } 98 99 if ( my $port = $self->port ) { 100 return 1 if $port == 443; 101 } 102 103 return 0; 104} 105 106# proxy request? 107has proxy_request => ( 108 is => 'rw', 109 isa => 'Str', # TODO: union(Uri, Undef) type 110# coerce => 1, 111 lazy_build => 1, 112); 113 114sub _build_proxy_request { 115 my $self = shift; 116 return '' unless $self->request_uri; # TODO: return undef 117 return '' unless $self->request_uri =~ m!^https?://!i; # TODO: return undef 118 return $self->request_uri; # TODO: return URI->new($self->request_uri); 119} 120 121has uri => ( 122 is => 'rw', 123 isa => Uri, 124 coerce => 1, 125 lazy_build => 1, 126 handles => [qw(base path)], 127); 128 129sub _build_uri { 130 my $self = shift; 131 $self->request_builder->_build_uri($self); 132} 133 134has builder_options => ( 135 is => 'rw', 136 isa => 'HashRef', 137 default => sub { 138 +{ 139 disable_raw_body => 0, 140 upload_tmp => undef, 141 }, 142 }, 143); 144 145has raw_body => ( 146 is => 'rw', 147 isa => 'Str', 148 lazy_build => 1, 149); 150 151sub _build_raw_body { 152 my $self = shift; 153 $self->request_builder->_build_raw_body($self); 154} 155 156has headers => ( 157 is => 'rw', 158 isa => Header, 159 coerce => 1, 160 lazy_build => 1, 161 handles => [ qw(content_encoding content_length content_type header referer user_agent) ], 162); 163 164sub _build_headers { 165 my $self = shift; 166 $self->request_builder->_build_headers($self); 167} 168 169# Contains the URI base. This will always have a trailing slash. 170# If your application was queried with the URI C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>. 171 172has hostname => ( 173 is => 'rw', 174 isa => 'Str', 175 lazy_build => 1, 176); 177 178sub _build_hostname { 179 my $self = shift; 180 $self->request_builder->_build_hostname($self); 181} 182 183has http_body => ( 184 is => 'rw', 185 isa => 'HTTP::Body', 186 lazy_build => 1, 187 handles => { 188 body_parameters => 'param', 189 body => 'body', 190 }, 191); 192 193sub _build_http_body { 194 my $self = shift; 195 $self->request_builder->_build_http_body($self); 196} 197 198# contains body_params and query_params 199has parameters => ( 200 is => 'rw', 201 isa => 'HashRef', 202 lazy_build => 1, 203); 204 205sub _build_parameters { 206 my $self = shift; 207 208 my $query = $self->query_parameters; 209 my $body = $self->body_parameters; 210 211 my %merged; 212 213 foreach my $hash ( $query, $body ) { 214 foreach my $name ( keys %$hash ) { 215 my $param = $hash->{$name}; 216 push( @{ $merged{$name} ||= [] }, ( ref $param ? @$param : $param ) ); 217 } 218 } 219 220 foreach my $param ( values %merged ) { 221 $param = $param->[0] if @$param == 1; 222 } 223 224 return \%merged; 225} 226 227has uploads => ( 228 is => 'rw', 229 isa => 'HashRef', 230 lazy_build => 1, 231); 232 233sub _build_uploads { 234 my $self = shift; 235 $self->request_builder->_prepare_uploads($self); 236} 237 238# aliases 239*body_params = \&body_parameters; 240*input = \&body; 241*params = \¶meters; 242*query_params = \&query_parameters; 243*path_info = \&path; 244 245sub cookie { 246 my $self = shift; 247 248 return keys %{ $self->cookies } if @_ == 0; 249 250 if (@_ == 1) { 251 my $name = shift; 252 return undef unless exists $self->cookies->{$name}; ## no critic. 253 return $self->cookies->{$name}; 254 } 255 return; 256} 257 258sub param { 259 my $self = shift; 260 261 return keys %{ $self->parameters } if @_ == 0; 262 263 if (@_ == 1) { 264 my $param = shift; 265 return wantarray ? () : undef unless exists $self->parameters->{$param}; 266 267 if ( ref $self->parameters->{$param} eq 'ARRAY' ) { 268 return (wantarray) 269 ? @{ $self->parameters->{$param} } 270 : $self->parameters->{$param}->[0]; 271 } else { 272 return (wantarray) 273 ? ( $self->parameters->{$param} ) 274 : $self->parameters->{$param}; 275 } 276 } else { 277 my $field = shift; 278 $self->parameters->{$field} = [@_]; 279 } 280} 281 282sub upload { 283 my $self = shift; 284 285 return keys %{ $self->uploads } if @_ == 0; 286 287 if (@_ == 1) { 288 my $upload = shift; 289 return wantarray ? () : undef unless exists $self->uploads->{$upload}; 290 291 if (ref $self->uploads->{$upload} eq 'ARRAY') { 292 return (wantarray) 293 ? @{ $self->uploads->{$upload} } 294 : $self->uploads->{$upload}->[0]; 295 } else { 296 return (wantarray) 297 ? ( $self->uploads->{$upload} ) 298 : $self->uploads->{$upload}; 299 } 300 } else { 301 while ( my($field, $upload) = splice(@_, 0, 2) ) { 302 if ( exists $self->uploads->{$field} ) { 303 for ( $self->uploads->{$field} ) { 304 $_ = [$_] unless ref($_) eq "ARRAY"; 305 push(@{ $_ }, $upload); 306 } 307 } else { 308 $self->uploads->{$field} = $upload; 309 } 310 } 311 } 312} 313 314sub uri_with { 315 my($self, $args) = @_; 316 317 Carp::carp( 'No arguments passed to uri_with()' ) unless $args; 318 319 for my $value (values %{ $args }) { 320 next unless defined $value; 321 for ( ref $value eq 'ARRAY' ? @{ $value } : $value ) { 322 $_ = "$_"; 323 utf8::encode( $_ ); 324 } 325 }; 326 327 my $uri = $self->uri->clone; 328 329 $uri->query_form( { 330 %{ $uri->query_form_hash }, 331 %{ $args }, 332 } ); 333 return $uri; 334} 335 336sub as_http_request { 337 my $self = shift; 338 require 'HTTP/Request.pm'; ## no critic 339 HTTP::Request->new( $self->method, $self->uri, $self->headers, $self->raw_body ); 340} 341 342sub absolute_url { 343 my ($self, $location) = @_; 344 345 unless ($location =~ m!^https?://!) { 346 return URI->new( $location )->abs( $self->base ); 347 } else { 348 return $location; 349 } 350} 351 352sub content { 353 my ( $self, @args ) = @_; 354 355 if ( @args ) { 356 Carp::croak "The HTTP::Request method 'content' is unsupported when used as a writer, use HTTP::Engine::RequestBuilder"; 357 } else { 358 return $self->raw_body; 359 } 360} 361 362sub as_string { 363 my $self = shift; 364 $self->as_http_request->as_string; # FIXME not efficient 365} 366 367sub parse { 368 Carp::croak "The HTTP::Request method 'parse' is unsupported, use HTTP::Engine::RequestBuilder"; 369} 370 371no Any::Moose; 372__PACKAGE__->meta->make_immutable(inline_destructor => 1); 3731; 374__END__ 375 376=for stopwords Stringifies URI http https param CGI.pm-compatible referer uri IP hostname API enviroments 377 378=head1 NAME 379 380HTTP::Engine::Request - Portable HTTP request object 381 382=head1 SYNOPSIS 383 384 # normally a request object is passed into your handler 385 sub handle_request { 386 my $req = shift; 387 388 }; 389 390=head1 DESCRIPTION 391 392L<HTTP::Engine::Request> provides a consistent API for request objects across web 393server enviroments. 394 395=head1 METHODS 396 397=head2 new 398 399 HTTP::Engine::Request->new( 400 request_builder => $BUILDER, 401 _connection => { 402 env => \%ENV, 403 input_handle => \*STDIN, 404 output_handle => \*STDOUT, 405 }, 406 %args 407 ); 408 409Normally, new() is not called directly, but a pre-built HTTP::Engine::Request 410object is passed for you into your request handler. You may build your own, 411following the example above. The C<$BUILDER> may be one of 412L<HTTP::Engine::RequestBuilder::CGI> or L<HTTP::Engine::RequestBuilder::NoEnv>. 413 414=head1 ATTRIBUTES 415 416=over 4 417 418=item builder_options 419 420configuration for control of HTTP::Engine::RequestBuilder. 421 422=over 4 423 424=item disable_raw_body 425 426$req->raw_body is not saved. 427 428When receiving upload of a big file, it uses in order to prevent raw_body becoming large. 429 430raw_body is enabled by the default. because of back compatibility. 431 432 $req->upload('file1'); 433 is $req->raw_body, '...some contents...'; 434 435 $req->builder_options->{disable_raw_body} = 1; 436 $req->upload('file2'); 437 is $req->raw_body, ''; 438 439 $req->builder_options->{disable_raw_body} = 0; 440 $req->upload('file1'); 441 is $req->raw_body, '...some contents...'; 442 443=item upload_tmp 444 445change temporarily directory to store upload file. 446It changes of default temporarily directory by L<HTTP::Body>. 447 448generally use L<File::Temp>. 449 450 $req->builder_options->{upload_tmp} = File::Temp->newdir; 451 452for lazy make directory 453 454 $req->builder_options->{upload_tmp} = sub { File::Temp->newdir }; 455 456In these examples, if request processing finishes, upload files will be deleted. 457 458=back 459 460=item address 461 462Returns the IP address of the client. 463 464=item cookies 465 466Returns a reference to a hash containing the cookies 467 468=item method 469 470Contains the request method (C<GET>, C<POST>, C<HEAD>, etc). 471 472=item protocol 473 474Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request. 475 476=item request_uri 477 478Returns the request uri (like $ENV{REQUEST_URI}) 479 480=item query_parameters 481 482Returns a reference to a hash containing query string (GET) parameters. Values can 483be either a scalar or an arrayref containing scalars. 484 485=item secure 486 487Returns true or false, indicating whether the connection is secure (https). 488 489=item proxy_request 490 491Returns undef or uri, if it is proxy request, uri of a connection place is returned. 492 493=item uri 494 495Returns a URI object for the current request. Stringifies to the URI text. 496 497=item user 498 499Returns REMOTE_USER. 500 501=item raw_body 502 503Returns string containing body(POST). 504 505=item headers 506 507Returns an L<HTTP::Headers> object containing the headers for the current request. 508 509=item base 510 511Contains the URI base. This will always have a trailing slash. 512 513=item hostname 514 515Returns the hostname of the client. 516 517=item http_body 518 519Returns an L<HTTP::Body> object. 520 521=item parameters 522 523Returns a reference to a hash containing GET and POST parameters. Values can 524be either a scalar or an arrayref containing scalars. 525 526=item uploads 527 528Returns a reference to a hash containing uploads. Values can be either a 529L<HTTP::Engine::Request::Upload> object, or an arrayref of 530L<HTTP::Engine::Request::Upload> objects. 531 532=item content_encoding 533 534Shortcut to $req->headers->content_encoding. 535 536=item content_length 537 538Shortcut to $req->headers->content_length. 539 540=item content_type 541 542Shortcut to $req->headers->content_type. 543 544=item header 545 546Shortcut to $req->headers->header. 547 548=item referer 549 550Shortcut to $req->headers->referer. 551 552=item user_agent 553 554Shortcut to $req->headers->user_agent. 555 556=item cookie 557 558A convenient method to access $req->cookies. 559 560 $cookie = $req->cookie('name'); 561 @cookies = $req->cookie; 562 563=item param 564 565Returns GET and POST parameters with a CGI.pm-compatible param method. This 566is an alternative method for accessing parameters in $req->parameters. 567 568 $value = $req->param( 'foo' ); 569 @values = $req->param( 'foo' ); 570 @params = $req->param; 571 572Like L<CGI>, and B<unlike> earlier versions of Catalyst, passing multiple 573arguments to this method, like this: 574 575 $req->param( 'foo', 'bar', 'gorch', 'quxx' ); 576 577will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and 578C<quxx>. Previously this would have added C<bar> as another value to C<foo> 579(creating it if it didn't exist before), and C<quxx> as another value for 580C<gorch>. 581 582=item path 583 584Returns the path, i.e. the part of the URI after $req->base, for the current request. 585 586=item upload 587 588A convenient method to access $req->uploads. 589 590 $upload = $req->upload('field'); 591 @uploads = $req->upload('field'); 592 @fields = $req->upload; 593 594 for my $upload ( $req->upload('field') ) { 595 print $upload->filename; 596 } 597 598 599=item uri_with 600 601Returns a rewritten URI object for the current request. Key/value pairs 602passed in will override existing parameters. Unmodified pairs will be 603preserved. 604 605=item as_http_request 606 607convert HTTP::Engine::Request to HTTP::Request. 608 609=item $req->absolute_url($location) 610 611convert $location to absolute uri. 612 613=back 614 615=head1 AUTHORS 616 617Kazuhiro Osawa and HTTP::Engine Authors. 618 619=head1 THANKS TO 620 621L<Catalyst::Request> 622 623=head1 SEE ALSO 624 625L<HTTP::Request>, L<Catalyst::Request> 626