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