lib/Catalyst/Engine.pm

   1 package Catalyst::Engine;
   2
   3 use Moose;
   4 with 'MooseX::Emulate::Class::Accessor::Fast';
   5
   6 use CGI::Simple::Cookie;
   7 use Data::Dump qw/dump/;
   8 use Errno 'EWOULDBLOCK';
   9 use HTML::Entities;
  10 use HTTP::Headers;
  11 use Plack::Loader;
  12 use Catalyst::EngineLoader;
  13 use Encode 2.21 'decode_utf8', 'encode', 'decode';
  14 use Plack::Request::Upload;
  15 use Hash::MultiValue;
  16 use namespace::clean -except => 'meta';
  17 use utf8;
  18
  19 # Amount of data to read from input on each pass
  20 our $CHUNKSIZE = 64 * 1024;
  21
  22 # XXX - this is only here for compat, do not use!
  23 has env => ( is => 'rw', writer => '_set_env' , weak_ref=>1);
  24 my $WARN_ABOUT_ENV = 0;
  25 around env => sub {
  26   my ($orig, $self, @args) = @_;
  27   if(@args) {
  28     warn "env as a writer is deprecated, you probably need to upgrade Catalyst::Engine::PSGI"
  29       unless $WARN_ABOUT_ENV++;
  30     return $self->_set_env(@args);
  31   }
  32   return $self->$orig;
  33 };
  34
  35 # XXX - Only here for Engine::PSGI compat
  36 sub prepare_connection {
  37     my ($self, $ctx) = @_;
  38     $ctx->request->prepare_connection;
  39 }
  40
  41 =head1 NAME
  42
  43 Catalyst::Engine - The Catalyst Engine
  44
  45 =head1 SYNOPSIS
  46
  47 See L<Catalyst>.
  48
  49 =head1 DESCRIPTION
  50
  51 =head1 METHODS
  52
  53
  54 =head2 $self->finalize_body($c)
  55
  56 Finalize body.  Prints the response output as blocking stream if it looks like
  57 a filehandle, otherwise write it out all in one go.  If there is no body in
  58 the response, we assume you are handling it 'manually', such as for nonblocking
  59 style or asynchronous streaming responses.  You do this by calling L</write>
  60 several times (which sends HTTP headers if needed) or you close over
  61 C<< $response->write_fh >>.
  62
  63 See L<Catalyst::Response/write> and L<Catalyst::Response/write_fh> for more.
  64
  65 =cut
  66
  67 sub finalize_body {
  68     my ( $self, $c ) = @_;
  69     my $res = $c->response; # We use this all over
  70
  71     ## If we've asked for the write 'filehandle' that means the application is
  72     ## doing something custom and is expected to close the response
  73     return if $res->_has_write_fh;
  74
  75     my $body = $res->body; # save some typing
  76     if($res->_has_response_cb) {
  77         ## we have not called the response callback yet, so we are safe to send
  78         ## the whole body to PSGI
  79
  80         my @headers;
  81         $res->headers->scan(sub { push @headers, @_ });
  82
  83         # We need to figure out what kind of body we have and normalize it to something
  84         # PSGI can deal with
  85         if(defined $body) {
  86             # Handle objects first
  87             if(blessed($body)) {
  88                 if($body->can('getline')) {
  89                     # Body is an IO handle that meets the PSGI spec.  Nothing to normalize
  90                 } elsif($body->can('read')) {
  91
  92                     # In the past, Catalyst only looked for ->read not ->getline.  It is very possible
  93                     # that one might have an object that respected read but did not have getline.
  94                     # As a result, we need to handle this case for backcompat.
  95
  96                     # We will just do the old loop for now.  In a future version of Catalyst this support
  97                     # will be removed and one will have to rewrite their custom object or use
  98                     # Plack::Middleware::AdaptFilehandleRead.  In anycase support for this is officially
  99                     # deprecated and described as such as of 5.90060
 100
 101                     my $got;
 102                     do {
 103                         $got = read $body, my ($buffer), $CHUNKSIZE;
 104                         $got = 0 unless $self->write($c, $buffer );
 105                     } while $got > 0;
 106
 107                     close $body;
 108                     return;
 109                 } else {
 110                     # Looks like for  backcompat reasons we need to be able to deal
 111                     # with stringyfiable objects.
 112                     $body = ["$body"];
 113                 }
 114             } elsif(ref $body) {
 115                 if( (ref($body) eq 'GLOB') or (ref($body) eq 'ARRAY')) {
 116                   # Again, PSGI can just accept this, no transform needed.  We don't officially
 117                   # document the body as arrayref at this time (and there's not specific test
 118                   # cases.  we support it because it simplifies some plack compatibility logic
 119                   # and we might make it official at some point.
 120                 } else {
 121                    $c->log->error("${\ref($body)} is not a valid value for Response->body");
 122                    return;
 123                 }
 124             } else {
 125                 # Body is defined and not an object or reference.  We assume a simple value
 126                 # and wrap it in an array for PSGI
 127                 $body = [$body];
 128             }
 129         } else {
 130             # There's no body...
 131             $body = [];
 132         }
 133         $res->_response_cb->([ $res->status, \@headers, $body]);
 134         $res->_clear_response_cb;
 135
 136     } else {
 137         ## Now, if there's no response callback anymore, that means someone has
 138         ## called ->write in order to stream 'some stuff along the way'.  I think
 139         ## for backcompat we still need to handle a ->body.  I guess I could see
 140         ## someone calling ->write to presend some stuff, and then doing the rest
 141         ## via ->body, like in a template.
 142
 143         ## We'll just use the old, existing code for this (or most of it)
 144
 145         if(my $body = $res->body) {
 146
 147           if ( blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) {
 148
 149               ## In this case we have no choice and will fall back on the old
 150               ## manual streaming stuff.  Not optimal.  This is deprecated as of 5.900560+
 151
 152               my $got;
 153               do {
 154                   $got = read $body, my ($buffer), $CHUNKSIZE;
 155                   $got = 0 unless $self->write($c, $buffer );
 156               } while $got > 0;
 157
 158               close $body;
 159           }
 160           else {
 161
 162               # Case where body was set after calling ->write.  We'd prefer not to
 163               # support this, but I can see some use cases with the way most of the
 164               # views work. Since body has already been encoded, we need to do
 165               # an 'unencoded_write' here.
 166               $self->unencoded_write( $c, $body );
 167           }
 168         }
 169
 170         $res->_writer->close;
 171         $res->_clear_writer;
 172     }
 173
 174     return;
 175 }
 176
 177 =head2 $self->finalize_cookies($c)
 178
 179 Create CGI::Simple::Cookie objects from $c->res->cookies, and set them as
 180 response headers.
 181
 182 =cut
 183
 184 sub finalize_cookies {
 185     my ( $self, $c ) = @_;
 186
 187     my @cookies;
 188     my $response = $c->response;
 189
 190     foreach my $name (keys %{ $response->cookies }) {
 191
 192         my $val = $response->cookies->{$name};
 193
 194         my $cookie = (
 195             blessed($val)
 196             ? $val
 197             : CGI::Simple::Cookie->new(
 198                 -name    => $name,
 199                 -value   => $val->{value},
 200                 -expires => $val->{expires},
 201                 -domain  => $val->{domain},
 202                 -path    => $val->{path},
 203                 -secure  => $val->{secure} || 0,
 204                 -httponly => $val->{httponly} || 0,
 205                 -samesite => $val->{samesite},
 206             )
 207         );
 208         if (!defined $cookie) {
 209             $c->log->warn("undef passed in '$name' cookie value - not setting cookie")
 210                 if $c->debug;
 211             next;
 212         }
 213
 214         push @cookies, $cookie->as_string;
 215     }
 216
 217     for my $cookie (@cookies) {
 218         $response->headers->push_header( 'Set-Cookie' => $cookie );
 219     }
 220 }
 221
 222 =head2 $self->finalize_error($c)
 223
 224 Output an appropriate error message. Called if there's an error in $c
 225 after the dispatch has finished. Will output debug messages if Catalyst
 226 is in debug mode, or a `please come back later` message otherwise.
 227
 228 =cut
 229
 230 sub _dump_error_page_element {
 231     my ($self, $i, $element) = @_;
 232     my ($name, $val)  = @{ $element };
 233
 234     # This is fugly, but the metaclass is _HUGE_ and demands waaay too much
 235     # scrolling. Suggestions for more pleasant ways to do this welcome.
 236     local $val->{'__MOP__'} = "Stringified: "
 237         . $val->{'__MOP__'} if ref $val eq 'HASH' && exists $val->{'__MOP__'};
 238
 239     my $text = encode_entities( dump( $val ));
 240     sprintf <<"EOF", $name, $text;
 241 <h2><a href="#" onclick="toggleDump('dump_$i'); return false">%s</a></h2>
 242 <div id="dump_$i">
 243     <pre wrap="">%s</pre>
 244 </div>
 245 EOF
 246 }
 247
 248 sub finalize_error {
 249     my ( $self, $c ) = @_;
 250
 251     $c->res->content_type('text/html; charset=utf-8');
 252     my $name = ref($c)->config->{name} || join(' ', split('::', ref $c));
 253
 254     # Prevent Catalyst::Plugin::Unicode::Encoding from running.
 255     # This is a little nasty, but it's the best way to be clean whether or
 256     # not the user has an encoding plugin.
 257
 258     if ($c->can('encoding')) {
 259       $c->{encoding} = '';
 260     }
 261
 262     my ( $title, $error, $infos );
 263     if ( $c->debug ) {
 264
 265         # For pretty dumps
 266         $error = join '', map {
 267                 '<p><code class="error">'
 268               . encode_entities($_)
 269               . '</code></p>'
 270         } @{ $c->error };
 271         $error ||= 'No output';
 272         $error = qq{<pre wrap="">$error</pre>};
 273         $title = $name = "$name on Catalyst $Catalyst::VERSION";
 274         $name  = "<h1>$name</h1>";
 275
 276         # Don't show context in the dump
 277         $c->res->_clear_context;
 278
 279         # Don't show body parser in the dump
 280         $c->req->_clear_body;
 281
 282         my @infos;
 283         my $i = 0;
 284         for my $dump ( $c->dump_these ) {
 285             push @infos, $self->_dump_error_page_element($i, $dump);
 286             $i++;
 287         }
 288         $infos = join "\n", @infos;
 289     }
 290     else {
 291         $title = $name;
 292         $error = '';
 293         $infos = <<"";
 294 <pre>
 295 (en) Please come back later
 296 (fr) SVP veuillez revenir plus tard
 297 (de) Bitte versuchen sie es spaeter nocheinmal
 298 (at) Konnten's bitt'schoen spaeter nochmal reinschauen
 299 (no) Vennligst prov igjen senere
 300 (dk) Venligst prov igen senere
 301 (pl) Prosze sprobowac pozniej
 302 (pt) Por favor volte mais tarde
 303 (ru) Попробуйте еще раз позже
 304 (ua) Спробуйте ще раз пізніше
 305 (it) Per favore riprova più tardi
 306 </pre>
 307
 308         $name = '';
 309     }
 310     $c->res->body( <<"" );
 311 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 312     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
 313 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
 314 <head>
 315     <meta http-equiv="Content-Language" content="en" />
 316     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
 317     <title>$title</title>
 318     <script type="text/javascript">
 319         <!--
 320         function toggleDump (dumpElement) {
 321             var e = document.getElementById( dumpElement );
 322             if (e.style.display == "none") {
 323                 e.style.display = "";
 324             }
 325             else {
 326                 e.style.display = "none";
 327             }
 328         }
 329         -->
 330     </script>
 331     <style type="text/css">
 332         body {
 333             font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
 334                          Tahoma, Arial, helvetica, sans-serif;
 335             color: #333;
 336             background-color: #eee;
 337             margin: 0px;
 338             padding: 0px;
 339         }
 340         :link, :link:hover, :visited, :visited:hover {
 341             color: #000;
 342         }
 343         div.box {
 344             position: relative;
 345             background-color: #ccc;
 346             border: 1px solid #aaa;
 347             padding: 4px;
 348             margin: 10px;
 349         }
 350         div.error {
 351             background-color: #cce;
 352             border: 1px solid #755;
 353             padding: 8px;
 354             margin: 4px;
 355             margin-bottom: 10px;
 356         }
 357         div.infos {
 358             background-color: #eee;
 359             border: 1px solid #575;
 360             padding: 8px;
 361             margin: 4px;
 362             margin-bottom: 10px;
 363         }
 364         div.name {
 365             background-color: #cce;
 366             border: 1px solid #557;
 367             padding: 8px;
 368             margin: 4px;
 369         }
 370         code.error {
 371             display: block;
 372             margin: 1em 0;
 373             overflow: auto;
 374         }
 375         div.name h1, div.error p {
 376             margin: 0;
 377         }
 378         h2 {
 379             margin-top: 0;
 380             margin-bottom: 10px;
 381             font-size: medium;
 382             font-weight: bold;
 383             text-decoration: underline;
 384         }
 385         h1 {
 386             font-size: medium;
 387             font-weight: normal;
 388         }
 389         /* from http://users.tkk.fi/~tkarvine/linux/doc/pre-wrap/pre-wrap-css3-mozilla-opera-ie.html */
 390         /* Browser specific (not valid) styles to make preformatted text wrap */
 391         pre {
 392             white-space: pre-wrap;       /* css-3 */
 393             white-space: -moz-pre-wrap;  /* Mozilla, since 1999 */
 394             white-space: -pre-wrap;      /* Opera 4-6 */
 395             white-space: -o-pre-wrap;    /* Opera 7 */
 396             word-wrap: break-word;       /* Internet Explorer 5.5+ */
 397         }
 398     </style>
 399 </head>
 400 <body>
 401     <div class="box">
 402         <div class="error">$error</div>
 403         <div class="infos">$infos</div>
 404         <div class="name">$name</div>
 405     </div>
 406 </body>
 407 </html>
 408
 409     # Trick IE. Old versions of IE would display their own error page instead
 410     # of ours if we'd give it less than 512 bytes.
 411     $c->res->{body} .= ( ' ' x 512 );
 412
 413     $c->res->{body} = Encode::encode("UTF-8", $c->res->{body});
 414
 415     # Return 500
 416     $c->res->status(500);
 417 }
 418
 419 =head2 $self->finalize_headers($c)
 420
 421 Allows engines to write headers to response
 422
 423 =cut
 424
 425 sub finalize_headers {
 426     my ($self, $ctx) = @_;
 427
 428     $ctx->finalize_headers unless $ctx->response->finalized_headers;
 429     return;
 430 }
 431
 432 =head2 $self->finalize_uploads($c)
 433
 434 Clean up after uploads, deleting temp files.
 435
 436 =cut
 437
 438 sub finalize_uploads {
 439     my ( $self, $c ) = @_;
 440
 441     # N.B. This code is theoretically entirely unneeded due to ->cleanup(1)
 442     #      on the HTTP::Body object.
 443     my $request = $c->request;
 444     foreach my $key (keys %{ $request->uploads }) {
 445         my $upload = $request->uploads->{$key};
 446         unlink grep { -e $_ } map { $_->tempname }
 447           (ref $upload eq 'ARRAY' ? @{$upload} : ($upload));
 448     }
 449
 450 }
 451
 452 =head2 $self->prepare_body($c)
 453
 454 sets up the L<Catalyst::Request> object body using L<HTTP::Body>
 455
 456 =cut
 457
 458 sub prepare_body {
 459     my ( $self, $c ) = @_;
 460
 461     $c->request->prepare_body;
 462 }
 463
 464 =head2 $self->prepare_body_chunk($c)
 465
 466 Add a chunk to the request body.
 467
 468 =cut
 469
 470 # XXX - Can this be deleted?
 471 sub prepare_body_chunk {
 472     my ( $self, $c, $chunk ) = @_;
 473
 474     $c->request->prepare_body_chunk($chunk);
 475 }
 476
 477 =head2 $self->prepare_body_parameters($c)
 478
 479 Sets up parameters from body.
 480
 481 =cut
 482
 483 sub prepare_body_parameters {
 484     my ( $self, $c ) = @_;
 485
 486     $c->request->prepare_body_parameters;
 487 }
 488
 489 =head2 $self->prepare_parameters($c)
 490
 491 Sets up parameters from query and post parameters.
 492 If parameters have already been set up will clear
 493 existing parameters and set up again.
 494
 495 =cut
 496
 497 sub prepare_parameters {
 498     my ( $self, $c ) = @_;
 499
 500     $c->request->_clear_parameters;
 501     return $c->request->parameters;
 502 }
 503
 504 =head2 $self->prepare_path($c)
 505
 506 abstract method, implemented by engines.
 507
 508 =cut
 509
 510 sub prepare_path {
 511     my ($self, $ctx) = @_;
 512
 513     my $env = $ctx->request->env;
 514
 515     my $scheme    = $ctx->request->secure ? 'https' : 'http';
 516     my $host      = $env->{HTTP_HOST} || $env->{SERVER_NAME};
 517     my $port      = $env->{SERVER_PORT} || 80;
 518     my $base_path = $env->{SCRIPT_NAME} || "/";
 519
 520     # set the request URI
 521     my $path;
 522     if (!$ctx->config->{use_request_uri_for_path}) {
 523         my $path_info = $env->{PATH_INFO};
 524         if ( exists $env->{REDIRECT_URL} ) {
 525             $base_path = $env->{REDIRECT_URL};
 526             $base_path =~ s/\Q$path_info\E$//;
 527         }
 528         $path = $base_path . $path_info;
 529         $path =~ s{^/+}{};
 530         $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
 531         $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
 532     }
 533     else {
 534         my $req_uri = $env->{REQUEST_URI};
 535         $req_uri =~ s/\?.*$//;
 536         $path = $req_uri;
 537         $path =~ s{^/+}{};
 538     }
 539
 540     # Using URI directly is way too slow, so we construct the URLs manually
 541     my $uri_class = "URI::$scheme";
 542
 543     # HTTP_HOST will include the port even if it's 80/443
 544     $host =~ s/:(?:80|443)$//;
 545
 546     if ($port !~ /^(?:80|443)$/ && $host !~ /:/) {
 547         $host .= ":$port";
 548     }
 549
 550     my $query = $env->{QUERY_STRING} ? '?' . $env->{QUERY_STRING} : '';
 551     my $uri   = $scheme . '://' . $host . '/' . $path . $query;
 552
 553     $ctx->request->uri( (bless \$uri, $uri_class)->canonical );
 554
 555     # set the base URI
 556     # base must end in a slash
 557     $base_path .= '/' unless $base_path =~ m{/$};
 558
 559     my $base_uri = $scheme . '://' . $host . $base_path;
 560
 561     $ctx->request->base( bless \$base_uri, $uri_class );
 562
 563     return;
 564 }
 565
 566 =head2 $self->prepare_request($c)
 567
 568 =head2 $self->prepare_query_parameters($c)
 569
 570 process the query string and extract query parameters.
 571
 572 =cut
 573
 574 sub prepare_query_parameters {
 575     my ($self, $c) = @_;
 576     my $env = $c->request->env;
 577     my $do_not_decode_query = $c->config->{do_not_decode_query};
 578
 579     my $old_encoding;
 580     if(my $new = $c->config->{default_query_encoding}) {
 581       $old_encoding = $c->encoding;
 582       $c->encoding($new);
 583     }
 584
 585     my $check = $c->config->{do_not_check_query_encoding} ? undef :$c->_encode_check;
 586     my $decoder = sub {
 587       my $str = shift;
 588       return $str if $do_not_decode_query;
 589       return $c->_handle_param_unicode_decoding($str, $check);
 590     };
 591
 592     my $query_string = exists $env->{QUERY_STRING}
 593         ? $env->{QUERY_STRING}
 594         : '';
 595
 596     $query_string =~ s/\A[&;]+//;
 597
 598     my @unsplit_pairs = split /[&;]+/, $query_string;
 599     my $p = Hash::MultiValue->new();
 600
 601     my $is_first_pair = 1;
 602     for my $pair (@unsplit_pairs) {
 603         my ($name, $value)
 604           = map { defined $_ ? $decoder->($self->unescape_uri($_)) : $_ }
 605             ( split /=/, $pair, 2 )[0,1]; # slice forces two elements
 606
 607         if ($is_first_pair) {
 608             # If the first pair has no equal sign, then it means the isindex
 609             # flag is set.
 610             $c->request->query_keywords($name) unless defined $value;
 611
 612             $is_first_pair = 0;
 613         }
 614
 615         $p->add( $name => $value );
 616     }
 617
 618
 619     $c->encoding($old_encoding) if $old_encoding;
 620     $c->request->query_parameters( $c->request->_use_hash_multivalue ? $p : $p->mixed );
 621 }
 622
 623 =head2 $self->prepare_read($c)
 624
 625 Prepare to read by initializing the Content-Length from headers.
 626
 627 =cut
 628
 629 sub prepare_read {
 630     my ( $self, $c ) = @_;
 631
 632     # Initialize the amount of data we think we need to read
 633     $c->request->_read_length;
 634 }
 635
 636 =head2 $self->prepare_request(@arguments)
 637
 638 Populate the context object from the request object.
 639
 640 =cut
 641
 642 sub prepare_request {
 643     my ($self, $ctx, %args) = @_;
 644     $ctx->log->psgienv($args{env}) if $ctx->log->can('psgienv');
 645     $ctx->request->_set_env($args{env});
 646     $self->_set_env($args{env}); # Nasty back compat!
 647     $ctx->response->_set_response_cb($args{response_cb});
 648 }
 649
 650 =head2 $self->prepare_uploads($c)
 651
 652 =cut
 653
 654 sub prepare_uploads {
 655     my ( $self, $c ) = @_;
 656
 657     my $request = $c->request;
 658     return unless $request->_body;
 659
 660     my $enc = $c->encoding;
 661     my $uploads = $request->_body->upload;
 662     my $parameters = $request->parameters;
 663     foreach my $name (keys %$uploads) {
 664         my $files = $uploads->{$name};
 665         $name = $c->_handle_unicode_decoding($name) if $enc;
 666         my @uploads;
 667         for my $upload (ref $files eq 'ARRAY' ? @$files : ($files)) {
 668             my $headers = HTTP::Headers->new( %{ $upload->{headers} } );
 669             my $filename = $upload->{filename};
 670             $filename = $c->_handle_unicode_decoding($filename) if $enc;
 671
 672             my $u = Catalyst::Request::Upload->new
 673               (
 674                size => $upload->{size},
 675                type => scalar $headers->content_type,
 676                charset => scalar $headers->content_type_charset,
 677                headers => $headers,
 678                tempname => $upload->{tempname},
 679                filename => $filename,
 680               );
 681             push @uploads, $u;
 682         }
 683         $request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0];
 684
 685         # support access to the filename as a normal param
 686         my @filenames = map { $_->{filename} } @uploads;
 687         # append, if there's already params with this name
 688         if (exists $parameters->{$name}) {
 689             if (ref $parameters->{$name} eq 'ARRAY') {
 690                 push @{ $parameters->{$name} }, @filenames;
 691             }
 692             else {
 693                 $parameters->{$name} = [ $parameters->{$name}, @filenames ];
 694             }
 695         }
 696         else {
 697             $parameters->{$name} = @filenames > 1 ? \@filenames : $filenames[0];
 698         }
 699     }
 700 }
 701
 702 =head2 $self->write($c, $buffer)
 703
 704 Writes the buffer to the client.
 705
 706 =cut
 707
 708 sub write {
 709     my ( $self, $c, $buffer ) = @_;
 710
 711     $c->response->write($buffer);
 712 }
 713
 714 =head2 $self->unencoded_write($c, $buffer)
 715
 716 Writes the buffer to the client without encoding. Necessary for
 717 already encoded buffers. Used when a $c->write has been done
 718 followed by $c->res->body.
 719
 720 =cut
 721
 722 sub unencoded_write {
 723     my ( $self, $c, $buffer ) = @_;
 724
 725     $c->response->unencoded_write($buffer);
 726 }
 727
 728 =head2 $self->read($c, [$maxlength])
 729
 730 Reads from the input stream by calling C<< $self->read_chunk >>.
 731
 732 Maintains the read_length and read_position counters as data is read.
 733
 734 =cut
 735
 736 sub read {
 737     my ( $self, $c, $maxlength ) = @_;
 738
 739     $c->request->read($maxlength);
 740 }
 741
 742 =head2 $self->read_chunk($c, \$buffer, $length)
 743
 744 Each engine implements read_chunk as its preferred way of reading a chunk
 745 of data. Returns the number of bytes read. A return of 0 indicates that
 746 there is no more data to be read.
 747
 748 =cut
 749
 750 sub read_chunk {
 751     my ($self, $ctx) = (shift, shift);
 752     return $ctx->request->read_chunk(@_);
 753 }
 754
 755 =head2 $self->run($app, $server)
 756
 757 Start the engine. Builds a PSGI application and calls the
 758 run method on the server passed in, which then causes the
 759 engine to loop, handling requests..
 760
 761 =cut
 762
 763 sub run {
 764     my ($self, $app, $psgi, @args) = @_;
 765     # @args left here rather than just a $options, $server for back compat with the
 766     # old style scripts which send a few args, then a hashref
 767
 768     # They should never actually be used in the normal case as the Plack engine is
 769     # passed in got all the 'standard' args via the loader in the script already.
 770
 771     # FIXME - we should stash the options in an attribute so that custom args
 772     # like Gitalist's --git_dir are possible to get from the app without stupid tricks.
 773     my $server = pop @args if (scalar @args && blessed $args[-1]);
 774     my $options = pop @args if (scalar @args && ref($args[-1]) eq 'HASH');
 775     # Back compat hack for applications with old (non Catalyst::Script) scripts to work in FCGI.
 776     if (scalar @args && !ref($args[0])) {
 777         if (my $listen = shift @args) {
 778             $options->{listen} ||= [$listen];
 779         }
 780     }
 781     if (! $server ) {
 782         $server = Catalyst::EngineLoader->new(application_name => ref($self))->auto(%$options);
 783         # We're not being called from a script, so auto detect what backend to
 784         # run on.  This should never happen, as mod_perl never calls ->run,
 785         # instead the $app->handle method is called per request.
 786         $app->log->warn("Not supplied a Plack engine, falling back to engine auto-loader (are your scripts ancient?)")
 787     }
 788     $app->run_options($options);
 789     $server->run($psgi, $options);
 790 }
 791
 792 =head2 build_psgi_app ($app, @args)
 793
 794 Builds and returns a PSGI application closure. (Raw, not wrapped in middleware)
 795
 796 =cut
 797
 798 sub build_psgi_app {
 799     my ($self, $app, @args) = @_;
 800
 801     return sub {
 802         my ($env) = @_;
 803
 804         return sub {
 805             my ($respond) = @_;
 806             confess("Did not get a response callback for writer, cannot continue") unless $respond;
 807             $app->handle_request(env => $env, response_cb => $respond);
 808         };
 809     };
 810 }
 811
 812 =head2 $self->unescape_uri($uri)
 813
 814 Unescapes a given URI using the most efficient method available.  Engines such
 815 as Apache may implement this using Apache's C-based modules, for example.
 816
 817 =cut
 818
 819 sub unescape_uri {
 820     my ( $self, $str ) = @_;
 821
 822     $str =~ s/(?:%([0-9A-Fa-f]{2})|\+)/defined $1 ? chr(hex($1)) : ' '/eg;
 823
 824     return $str;
 825 }
 826
 827 =head2 $self->finalize_output
 828
 829 <obsolete>, see finalize_body
 830
 831 =head2 $self->env
 832
 833 Hash containing environment variables including many special variables inserted
 834 by WWW server - like SERVER_*, REMOTE_*, HTTP_* ...
 835
 836 Before accessing environment variables consider whether the same information is
 837 not directly available via Catalyst objects $c->request, $c->engine ...
 838
 839 BEWARE: If you really need to access some environment variable from your Catalyst
 840 application you should use $c->engine->env->{VARNAME} instead of $ENV{VARNAME},
 841 as in some environments the %ENV hash does not contain what you would expect.
 842
 843 =head1 AUTHORS
 844
 845 Catalyst Contributors, see Catalyst.pm
 846
 847 =head1 COPYRIGHT
 848
 849 This library is free software. You can redistribute it and/or modify it under
 850 the same terms as Perl itself.
 851
 852 =cut
 853
 854 __PACKAGE__->meta->make_immutable;
 855
 856 1;