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