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