/lib/HTTP/Engine/Request.pm

http://github.com/http-engine/HTTP-Engine · Perl · 626 lines · 461 code · 153 blank · 12 comment · 46 complexity · 816d20c022c9d992b830f2762572b23b MD5 · raw file

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