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