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
 308     $c->res->{body} .= ( ' ' x 512 );
 309
 310     # Return 500
 311     $c->res->status(500);
 312 }
 313
 314 =head2 $self->finalize_headers($c)
 315
 316 Abstract method, allows engines to write headers to response
 317
 318 =cut
 319
 320 sub finalize_headers {
 321     my ($self, $ctx) = @_;
 322
 323     my @headers;
 324     $ctx->response->headers->scan(sub { push @headers, @_ });
 325
 326     $self->_set_writer($self->_response_cb->([ $ctx->response->status, \@headers ]));
 327     $self->_clear_response_cb;
 328
 329     return;
 330 }
 331
 332 =head2 $self->finalize_read($c)
 333
 334 =cut
 335
 336 sub finalize_read { }
 337
 338 =head2 $self->finalize_uploads($c)
 339
 340 Clean up after uploads, deleting temp files.
 341
 342 =cut
 343
 344 sub finalize_uploads {
 345     my ( $self, $c ) = @_;
 346
 347     my $request = $c->request;
 348     foreach my $key (keys %{ $request->uploads }) {
 349         my $upload = $request->uploads->{$key};
 350         unlink grep { -e $_ } map { $_->tempname }
 351           (ref $upload eq 'ARRAY' ? @{$upload} : ($upload));
 352     }
 353
 354 }
 355
 356 =head2 $self->prepare_body($c)
 357
 358 sets up the L<Catalyst::Request> object body using L<HTTP::Body>
 359
 360 =cut
 361
 362 sub prepare_body {
 363     my ( $self, $c ) = @_;
 364
 365     my $appclass = ref($c) || $c;
 366     if ( my $length = $self->read_length ) {
 367         my $request = $c->request;
 368         unless ( $request->_body ) {
 369             my $type = $request->header('Content-Type');
 370             $request->_body(HTTP::Body->new( $type, $length ));
 371             $request->_body->tmpdir( $appclass->config->{uploadtmp} )
 372               if exists $appclass->config->{uploadtmp};
 373         }
 374
 375         # Check for definedness as you could read '0'
 376         while ( defined ( my $buffer = $self->read($c) ) ) {
 377             $c->prepare_body_chunk($buffer);
 378         }
 379
 380         # paranoia against wrong Content-Length header
 381         my $remaining = $length - $self->read_position;
 382         if ( $remaining > 0 ) {
 383             $self->finalize_read($c);
 384             Catalyst::Exception->throw(
 385                 "Wrong Content-Length value: $length" );
 386         }
 387     }
 388     else {
 389         # Defined but will cause all body code to be skipped
 390         $c->request->_body(0);
 391     }
 392 }
 393
 394 =head2 $self->prepare_body_chunk($c)
 395
 396 Add a chunk to the request body.
 397
 398 =cut
 399
 400 sub prepare_body_chunk {
 401     my ( $self, $c, $chunk ) = @_;
 402
 403     $c->request->_body->add($chunk);
 404 }
 405
 406 =head2 $self->prepare_body_parameters($c)
 407
 408 Sets up parameters from body.
 409
 410 =cut
 411
 412 sub prepare_body_parameters {
 413     my ( $self, $c ) = @_;
 414
 415     return unless $c->request->_body;
 416
 417     $c->request->body_parameters( $c->request->_body->param );
 418 }
 419
 420 =head2 $self->prepare_connection($c)
 421
 422 Abstract method implemented in engines.
 423
 424 =cut
 425
 426 sub prepare_connection {
 427     my ($self, $ctx) = @_;
 428
 429     my $env = $self->env;
 430     my $request = $ctx->request;
 431
 432     $request->address( $env->{REMOTE_ADDR} );
 433     $request->hostname( $env->{REMOTE_HOST} )
 434         if exists $env->{REMOTE_HOST};
 435     $request->protocol( $env->{SERVER_PROTOCOL} );
 436     $request->remote_user( $env->{REMOTE_USER} );
 437     $request->method( $env->{REQUEST_METHOD} );
 438     $request->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
 439
 440     return;
 441 }
 442
 443 =head2 $self->prepare_cookies($c)
 444
 445 Parse cookies from header. Sets a L<CGI::Simple::Cookie> object.
 446
 447 =cut
 448
 449 sub prepare_cookies {
 450     my ( $self, $c ) = @_;
 451
 452     if ( my $header = $c->request->header('Cookie') ) {
 453         $c->req->cookies( { CGI::Simple::Cookie->parse($header) } );
 454     }
 455 }
 456
 457 =head2 $self->prepare_headers($c)
 458
 459 =cut
 460
 461 sub prepare_headers {
 462     my ($self, $ctx) = @_;
 463
 464     my $env = $self->env;
 465     my $headers = $ctx->request->headers;
 466
 467     for my $header (keys %{ $env }) {
 468         next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
 469         (my $field = $header) =~ s/^HTTPS?_//;
 470         $field =~ tr/_/-/;
 471         $headers->header($field => $env->{$header});
 472     }
 473 }
 474
 475 =head2 $self->prepare_parameters($c)
 476
 477 sets up parameters from query and post parameters.
 478
 479 =cut
 480
 481 sub prepare_parameters {
 482     my ( $self, $c ) = @_;
 483
 484     my $request = $c->request;
 485     my $parameters = $request->parameters;
 486     my $body_parameters = $request->body_parameters;
 487     my $query_parameters = $request->query_parameters;
 488     # We copy, no references
 489     foreach my $name (keys %$query_parameters) {
 490         my $param = $query_parameters->{$name};
 491         $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
 492     }
 493
 494     # Merge query and body parameters
 495     foreach my $name (keys %$body_parameters) {
 496         my $param = $body_parameters->{$name};
 497         my @values = ref $param eq 'ARRAY' ? @$param : ($param);
 498         if ( my $existing = $parameters->{$name} ) {
 499           unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
 500         }
 501         $parameters->{$name} = @values > 1 ? \@values : $values[0];
 502     }
 503 }
 504
 505 =head2 $self->prepare_path($c)
 506
 507 abstract method, implemented by engines.
 508
 509 =cut
 510
 511 sub prepare_path {
 512     my ($self, $ctx) = @_;
 513
 514     my $env = $self->env;
 515
 516     my $scheme    = $ctx->request->secure ? 'https' : 'http';
 517     my $host      = $env->{HTTP_HOST} || $env->{SERVER_NAME};
 518     my $port      = $env->{SERVER_PORT} || 80;
 519     my $base_path = $env->{SCRIPT_NAME} || "/";
 520
 521     # set the request URI
 522     my $req_uri = $env->{REQUEST_URI};
 523     $req_uri =~ s/\?.*$//;
 524     my $path = $req_uri;
 525     $path =~ s{^/+}{};
 526
 527     # Using URI directly is way too slow, so we construct the URLs manually
 528     my $uri_class = "URI::$scheme";
 529
 530     # HTTP_HOST will include the port even if it's 80/443
 531     $host =~ s/:(?:80|443)$//;
 532
 533     if ($port !~ /^(?:80|443)$/ && $host !~ /:/) {
 534         $host .= ":$port";
 535     }
 536
 537     my $query = $env->{QUERY_STRING} ? '?' . $env->{QUERY_STRING} : '';
 538     my $uri   = $scheme . '://' . $host . '/' . $path . $query;
 539
 540     $ctx->request->uri( bless \$uri, $uri_class );
 541
 542     # set the base URI
 543     # base must end in a slash
 544     $base_path .= '/' unless $base_path =~ m{/$};
 545
 546     my $base_uri = $scheme . '://' . $host . $base_path;
 547
 548     $ctx->request->base( bless \$base_uri, $uri_class );
 549
 550     return;
 551 }
 552
 553 =head2 $self->prepare_request($c)
 554
 555 =head2 $self->prepare_query_parameters($c)
 556
 557 process the query string and extract query parameters.
 558
 559 =cut
 560
 561 sub prepare_query_parameters {
 562     my ($self, $c) = @_;
 563
 564     my $query_string = exists $self->env->{QUERY_STRING}
 565         ? $self->env->{QUERY_STRING}
 566         : '';
 567
 568     # Check for keywords (no = signs)
 569     # (yes, index() is faster than a regex :))
 570     if ( index( $query_string, '=' ) < 0 ) {
 571         $c->request->query_keywords( $self->unescape_uri($query_string) );
 572         return;
 573     }
 574
 575     my %query;
 576
 577     # replace semi-colons
 578     $query_string =~ s/;/&/g;
 579
 580     my @params = grep { length $_ } split /&/, $query_string;
 581
 582     for my $item ( @params ) {
 583
 584         my ($param, $value)
 585             = map { $self->unescape_uri($_) }
 586               split( /=/, $item, 2 );
 587
 588         $param = $self->unescape_uri($item) unless defined $param;
 589
 590         if ( exists $query{$param} ) {
 591             if ( ref $query{$param} ) {
 592                 push @{ $query{$param} }, $value;
 593             }
 594             else {
 595                 $query{$param} = [ $query{$param}, $value ];
 596             }
 597         }
 598         else {
 599             $query{$param} = $value;
 600         }
 601     }
 602
 603     $c->request->query_parameters( \%query );
 604 }
 605
 606 =head2 $self->prepare_read($c)
 607
 608 prepare to read from the engine.
 609
 610 =cut
 611
 612 sub prepare_read {
 613     my ( $self, $c ) = @_;
 614
 615     # Initialize the read position
 616     $self->read_position(0);
 617
 618     # Initialize the amount of data we think we need to read
 619     $self->read_length( $c->request->header('Content-Length') || 0 );
 620 }
 621
 622 =head2 $self->prepare_request(@arguments)
 623
 624 Populate the context object from the request object.
 625
 626 =cut
 627
 628 sub prepare_request {
 629     my ($self, $ctx, %args) = @_;
 630     $self->_set_env($args{env});
 631 }
 632
 633 =head2 $self->prepare_uploads($c)
 634
 635 =cut
 636
 637 sub prepare_uploads {
 638     my ( $self, $c ) = @_;
 639
 640     my $request = $c->request;
 641     return unless $request->_body;
 642
 643     my $uploads = $request->_body->upload;
 644     my $parameters = $request->parameters;
 645     foreach my $name (keys %$uploads) {
 646         my $files = $uploads->{$name};
 647         my @uploads;
 648         for my $upload (ref $files eq 'ARRAY' ? @$files : ($files)) {
 649             my $headers = HTTP::Headers->new( %{ $upload->{headers} } );
 650             my $u = Catalyst::Request::Upload->new
 651               (
 652                size => $upload->{size},
 653                type => $headers->content_type,
 654                headers => $headers,
 655                tempname => $upload->{tempname},
 656                filename => $upload->{filename},
 657               );
 658             push @uploads, $u;
 659         }
 660         $request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0];
 661
 662         # support access to the filename as a normal param
 663         my @filenames = map { $_->{filename} } @uploads;
 664         # append, if there's already params with this name
 665         if (exists $parameters->{$name}) {
 666             if (ref $parameters->{$name} eq 'ARRAY') {
 667                 push @{ $parameters->{$name} }, @filenames;
 668             }
 669             else {
 670                 $parameters->{$name} = [ $parameters->{$name}, @filenames ];
 671             }
 672         }
 673         else {
 674             $parameters->{$name} = @filenames > 1 ? \@filenames : $filenames[0];
 675         }
 676     }
 677 }
 678
 679 =head2 $self->prepare_write($c)
 680
 681 Abstract method. Implemented by the engines.
 682
 683 =cut
 684
 685 sub prepare_write { }
 686
 687 =head2 $self->read($c, [$maxlength])
 688
 689 Reads from the input stream by calling C<< $self->read_chunk >>.
 690
 691 Maintains the read_length and read_position counters as data is read.
 692
 693 =cut
 694
 695 sub read {
 696     my ( $self, $c, $maxlength ) = @_;
 697
 698     my $remaining = $self->read_length - $self->read_position;
 699     $maxlength ||= $CHUNKSIZE;
 700
 701     # Are we done reading?
 702     if ( $remaining <= 0 ) {
 703         $self->finalize_read($c);
 704         return;
 705     }
 706
 707     my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
 708     my $rc = $self->read_chunk( $c, my $buffer, $readlen );
 709     if ( defined $rc ) {
 710         if (0 == $rc) { # Nothing more to read even though Content-Length
 711                         # said there should be.
 712             $self->finalize_read;
 713             return;
 714         }
 715         $self->read_position( $self->read_position + $rc );
 716         return $buffer;
 717     }
 718     else {
 719         Catalyst::Exception->throw(
 720             message => "Unknown error reading input: $!" );
 721     }
 722 }
 723
 724 =head2 $self->read_chunk($c, $buffer, $length)
 725
 726 Each engine implements read_chunk as its preferred way of reading a chunk
 727 of data. Returns the number of bytes read. A return of 0 indicates that
 728 there is no more data to be read.
 729
 730 =cut
 731
 732 sub read_chunk {
 733     my ($self, $ctx) = (shift, shift);
 734     return $self->env->{'psgi.input'}->read(@_);
 735 }
 736
 737 =head2 $self->read_length
 738
 739 The length of input data to be read.  This is obtained from the Content-Length
 740 header.
 741
 742 =head2 $self->read_position
 743
 744 The amount of input data that has already been read.
 745
 746 =head2 $self->run($c)
 747
 748 Start the engine. Implemented by the various engine classes.
 749
 750 =cut
 751
 752 sub run {
 753     my ($self, $app, @args) = @_;
 754     Carp::cluck("Run");
 755     # FIXME - Do something sensible with the options we're passed
 756     $self->_run_psgi_app($self->_build_psgi_app($app, @args), @args);
 757 }
 758
 759 sub _build_psgi_app {
 760     my ($self, $app, @args) = @_;
 761
 762     my $psgi_app = sub {
 763         my ($env) = @_;
 764
 765         return sub {
 766             my ($respond) = @_;
 767             $self->_set_response_cb($respond);
 768             $app->handle_request(env => $env);
 769         };
 770     };
 771
 772     $psgi_app = Plack::Middleware::Conditional->wrap(
 773         $psgi_app,
 774         condition => sub {
 775             my ($env) = @_;
 776             return if $app->config->{ignore_frontend_proxy};
 777             return $env->{REMOTE_ADDR} eq '127.0.0.1' || $app->config->{using_frontend_proxy};
 778         },
 779         builder   => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) },
 780     );
 781
 782     return $psgi_app;
 783 }
 784
 785 sub _run_psgi_app {
 786     my ($self, $psgi_app, @args);
 787     # FIXME - Need to be able to specify engine and pass options..
 788     Plack::Loader->auto()->run($psgi_app);
 789 }
 790
 791 =head2 $self->write($c, $buffer)
 792
 793 Writes the buffer to the client.
 794
 795 =cut
 796
 797 sub write {
 798     my ( $self, $c, $buffer ) = @_;
 799
 800     unless ( $self->_prepared_write ) {
 801         $self->prepare_write($c);
 802         $self->_prepared_write(1);
 803     }
 804
 805     return 0 if !defined $buffer;
 806
 807     my $len = length($buffer);
 808     $self->_writer->write($buffer);
 809
 810     return $len;
 811 }
 812
 813 =head2 $self->unescape_uri($uri)
 814
 815 Unescapes a given URI using the most efficient method available.  Engines such
 816 as Apache may implement this using Apache's C-based modules, for example.
 817
 818 =cut
 819
 820 sub unescape_uri {
 821     my ( $self, $str ) = @_;
 822
 823     $str =~ s/(?:%([0-9A-Fa-f]{2})|\+)/defined $1 ? chr(hex($1)) : ' '/eg;
 824
 825     return $str;
 826 }
 827
 828 =head2 $self->finalize_output
 829
 830 <obsolete>, see finalize_body
 831
 832 =head2 $self->env
 833
 834 Hash containing enviroment variables including many special variables inserted
 835 by WWW server - like SERVER_*, REMOTE_*, HTTP_* ...
 836
 837 Before accesing enviroment variables consider whether the same information is
 838 not directly available via Catalyst objects $c->request, $c->engine ...
 839
 840 BEWARE: If you really need to access some enviroment variable from your Catalyst
 841 application you should use $c->engine->env->{VARNAME} instead of $ENV{VARNAME},
 842 as in some enviroments the %ENV hash does not contain what you would expect.
 843
 844 =head1 AUTHORS
 845
 846 Catalyst Contributors, see Catalyst.pm
 847
 848 =head1 COPYRIGHT
 849
 850 This library is free software. You can redistribute it and/or modify it under
 851 the same terms as Perl itself.
 852
 853 =cut
 854
 855 1;