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