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