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