Merge master into psgi branch
Tomas Doran [Sun, 24 Jul 2011 16:03:32 +0000 (17:03 +0100)]
1  2 
Changes
lib/Catalyst/Engine.pm
t/live_catalyst_test.t

diff --combined Changes
+++ b/Changes
@@@ -1,41 -1,41 +1,73 @@@
  # This file documents the revision history for Perl extension Catalyst.
  
+ 5.80033 2011-07-24 16:09:00
   Bug fixes:
+   - Fix Catalyst::Request so that the hostname accessor is not incorrectly
+     populated with 'localhost' if a reverse DNS lookup fails.
+   - Fix Path actions debug screen to display number of arguments
+   - Fix a regression that prevented configuring attributes for all actions using
+     ->config(actions => { '*' => \%attrs }) from working
+   - Append $\ in Catalyst::Response->print to more closely match
+     IO::Handle's behaviour.
+   - Fixed situation where a detach($action) from a forward within auto
+     was not breaking out correctly
    - Fix the disable_component_resolution_regex_fallback config setting
      to also work in the $c->component method.
  
+   - Handle users setting cookies with an undef value by not trying to
+     output that cookie (rather than trying to do so and causing an exception
+     as previously happened). A warning is logged if this occurs in debug
+     mode.
+   - Update tests to ignore $ENV{CATALYST_HOME} where required
+   - Change repository metadata to point at git.
+   - Clean namespaces in Catalyst::Request::Upload
+   - Catalyst::Test: Fixes to action_ok, action_redirect and action_notfound
+     test functions to be better documented, and have better default test
+     names.
+   - Update tests to ignore CATALYST_HOME env var.
 +5.89002 2011-03-02 11:30:00 (TRIAL release)
 +
 + Bug fixes:
 +  - Fix a couple of test failures caused by optional dependencies such as FCGI
 +    not being installed.
 +
 + Refactoring:
 +  - Simplified the API for getting a PSGI application code reference for a
 +    Catalyst application for use in, for example, .psgi files. See
 +    Catalyst::Upgrading for details.
 +
 +5.89001 2011-03-01 15:27:00 (TRIAL release)
 +
 + Bug fixes:
 +  - Fixed command-line argument passing in Catalyst::Script::FastCGI.
 +
 +  - Fixed Catalyst::Engine::Stomp compatibility. Applications using
 +    Catalyst::Engine::Stomp are believed to continue working without
 +    any changes with the new Catalyst major version.
 +
 +  - Fixed issues auto-loading engine with older scripts.
 +
 + Known problems:
 +  - Catalyst::Engine::Wx is officially unsupported and BROKEN. If you
 +    are using this engine then please get in touch with us and we'll
 +    be happy to help with the changes it needs to be compatible with
 +    the new major version of Catalyst.
 +
 + Documentation:
 +  - The section of Catalyst::Upgrading describing how to upgrade to version 5.90
 +    of Catalyst has been much improved.
 +
  5.80032 2011-02-23 01:10:00
  
   Bug fixes:
    - Fix undef warning in Catalyst::Engine::FastCGI when writing an empty
      body (e.g. doing a redirect)
  
 +5.89000 2011-01-24 09:28:45 (TRIAL release)
 +
 + This is a development release from psgi branch of Catalyst-Runtime.
 +
 + Removed features:
 +
 +  - All of the Catalyst::Engine::* namespace is now gone. Instead we only have
 +    one Catalyst::Engine class speaking the PSGI protocol natively. Everything
 +    the various Catalyst::Engine:: classes did before is now supposed to happen
 +    through PSGI handlers such as Plack::Handler::FCGI,
 +    Plack::Handler::HTTP::Server::PSGI, Plack::Handler::Apache2, and so
 +    on. However, deployment can still work the same as it did before. The
 +    catalyst scripts still exist and continue to work.
 +
 +    If you find anything that either doesn't work anymore as it did before or
 +    anything that could be done before with the various Catalyst::Engine::
 +    classes, but can't be done anymore with the single PSGI Catalyst::Engine
 +    class, please tell us *now*.
 +
  5.80030 2011-01-04 13:13:02
  
   New features:
diff --combined lib/Catalyst/Engine.pm
@@@ -10,26 -10,12 +10,26 @@@ use HTML::Entities
  use HTTP::Body;
  use HTTP::Headers;
  use URI::QueryParam;
 +use Moose::Util::TypeConstraints;
 +use Plack::Loader;
 +use Catalyst::EngineLoader;
  use Encode ();
  use utf8;
  
  use namespace::clean -except => 'meta';
  
 -has env => (is => 'rw');
 +has env => (is => 'ro', writer => '_set_env', clearer => '_clear_env');
 +
 +my $WARN_ABOUT_ENV = 0;
 +around env => sub {
 +  my ($orig, $self, @args) = @_;
 +  if(@args) {
 +    warn "env as a writer is deprecated, you probably need to upgrade Catalyst::Engine::PSGI"
 +      unless $WARN_ABOUT_ENV++;
 +    return $self->_set_env(@args);
 +  }
 +  return $self->$orig;
 +};
  
  # input position and length
  has read_length => (is => 'rw');
@@@ -37,21 -23,6 +37,21 @@@ has read_position => (is => 'rw')
  
  has _prepared_write => (is => 'rw');
  
 +has _response_cb => (
 +    is      => 'ro',
 +    isa     => 'CodeRef',
 +    writer  => '_set_response_cb',
 +    clearer => '_clear_response_cb',
 +    predicate => '_has_response_cb',
 +);
 +
 +has _writer => (
 +    is      => 'ro',
 +    isa     => duck_type([qw(write close)]),
 +    writer  => '_set_writer',
 +    clearer => '_clear_writer',
 +);
 +
  # Amount of data to read from input on each pass
  our $CHUNKSIZE = 64 * 1024;
  
@@@ -90,12 -61,6 +90,12 @@@ sub finalize_body 
      else {
          $self->write( $c, $body );
      }
 +
 +    $self->_writer->close;
 +    $self->_clear_writer;
 +    $self->_clear_env;
 +
 +    return;
  }
  
  =head2 $self->finalize_cookies($c)
@@@ -128,6 -93,11 +128,11 @@@ sub finalize_cookies 
                  -httponly => $val->{httponly} || 0,
              )
          );
+         if (!defined $cookie) {
+             $c->log->warn("undef passed in '$name' cookie value - not setting cookie")
+                 if $c->debug;
+             next;
+         }
  
          push @cookies, $cookie->as_string;
      }
@@@ -340,26 -310,7 +345,26 @@@ Abstract method, allows engines to writ
  
  =cut
  
 -sub finalize_headers { }
 +sub finalize_headers {
 +    my ($self, $ctx) = @_;
 +
 +    # This is a less-than-pretty hack to avoid breaking the old
 +    # Catalyst::Engine::PSGI. 5.9 Catalyst::Engine sets a response_cb and
 +    # expects us to pass headers to it here, whereas Catalyst::Enngine::PSGI
 +    # just pulls the headers out of $ctx->response in its run method and never
 +    # sets response_cb. So take the lack of a response_cb as a sign that we
 +    # don't need to set the headers.
 +
 +    return unless $self->_has_response_cb;
 +
 +    my @headers;
 +    $ctx->response->headers->scan(sub { push @headers, @_ });
 +
 +    $self->_set_writer($self->_response_cb->([ $ctx->response->status, \@headers ]));
 +    $self->_clear_response_cb;
 +
 +    return;
 +}
  
  =head2 $self->finalize_read($c)
  
@@@ -458,22 -409,7 +463,22 @@@ Abstract method implemented in engines
  
  =cut
  
 -sub prepare_connection { }
 +sub prepare_connection {
 +    my ($self, $ctx) = @_;
 +
 +    my $env = $self->env;
 +    my $request = $ctx->request;
 +
 +    $request->address( $env->{REMOTE_ADDR} );
 +    $request->hostname( $env->{REMOTE_HOST} )
 +        if exists $env->{REMOTE_HOST};
 +    $request->protocol( $env->{SERVER_PROTOCOL} );
 +    $request->remote_user( $env->{REMOTE_USER} );
 +    $request->method( $env->{REQUEST_METHOD} );
 +    $request->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
 +
 +    return;
 +}
  
  =head2 $self->prepare_cookies($c)
  
@@@ -493,19 -429,7 +498,19 @@@ sub prepare_cookies 
  
  =cut
  
 -sub prepare_headers { }
 +sub prepare_headers {
 +    my ($self, $ctx) = @_;
 +
 +    my $env = $self->env;
 +    my $headers = $ctx->request->headers;
 +
 +    for my $header (keys %{ $env }) {
 +        next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
 +        (my $field = $header) =~ s/^HTTPS?_//;
 +        $field =~ tr/_/-/;
 +        $headers->header($field => $env->{$header});
 +    }
 +}
  
  =head2 $self->prepare_parameters($c)
  
@@@ -543,61 -467,7 +548,61 @@@ abstract method, implemented by engines
  
  =cut
  
 -sub prepare_path { }
 +sub prepare_path {
 +    my ($self, $ctx) = @_;
 +
 +    my $env = $self->env;
 +
 +    my $scheme    = $ctx->request->secure ? 'https' : 'http';
 +    my $host      = $env->{HTTP_HOST} || $env->{SERVER_NAME};
 +    my $port      = $env->{SERVER_PORT} || 80;
 +    my $base_path = $env->{SCRIPT_NAME} || "/";
 +
 +    # set the request URI
 +    my $path;
 +    if (!$ctx->config->{use_request_uri_for_path}) {
 +        my $path_info = $env->{PATH_INFO};
 +        if ( exists $env->{REDIRECT_URL} ) {
 +            $base_path = $env->{REDIRECT_URL};
 +            $base_path =~ s/\Q$path_info\E$//;
 +        }
 +        $path = $base_path . $path_info;
 +        $path =~ s{^/+}{};
 +        $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
 +        $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
 +    }
 +    else {
 +        my $req_uri = $env->{REQUEST_URI};
 +        $req_uri =~ s/\?.*$//;
 +        $path = $req_uri;
 +        $path =~ s{^/+}{};
 +    }
 +
 +    # Using URI directly is way too slow, so we construct the URLs manually
 +    my $uri_class = "URI::$scheme";
 +
 +    # HTTP_HOST will include the port even if it's 80/443
 +    $host =~ s/:(?:80|443)$//;
 +
 +    if ($port !~ /^(?:80|443)$/ && $host !~ /:/) {
 +        $host .= ":$port";
 +    }
 +
 +    my $query = $env->{QUERY_STRING} ? '?' . $env->{QUERY_STRING} : '';
 +    my $uri   = $scheme . '://' . $host . '/' . $path . $query;
 +
 +    $ctx->request->uri( (bless \$uri, $uri_class)->canonical );
 +
 +    # set the base URI
 +    # base must end in a slash
 +    $base_path .= '/' unless $base_path =~ m{/$};
 +
 +    my $base_uri = $scheme . '://' . $host . $base_path;
 +
 +    $ctx->request->base( bless \$base_uri, $uri_class );
 +
 +    return;
 +}
  
  =head2 $self->prepare_request($c)
  
@@@ -608,11 -478,7 +613,11 @@@ process the query string and extract qu
  =cut
  
  sub prepare_query_parameters {
 -    my ( $self, $c, $query_string ) = @_;
 +    my ($self, $c) = @_;
 +
 +    my $query_string = exists $self->env->{QUERY_STRING}
 +        ? $self->env->{QUERY_STRING}
 +        : '';
  
      # Check for keywords (no = signs)
      # (yes, index() is faster than a regex :))
@@@ -674,10 -540,7 +679,10 @@@ Populate the context object from the re
  
  =cut
  
 -sub prepare_request { }
 +sub prepare_request {
 +    my ($self, $ctx, %args) = @_;
 +    $self->_set_env($args{env});
 +}
  
  =head2 $self->prepare_uploads($c)
  
@@@ -757,7 -620,7 +762,7 @@@ sub read 
      my $rc = $self->read_chunk( $c, my $buffer, $readlen );
      if ( defined $rc ) {
          if (0 == $rc) { # Nothing more to read even though Content-Length
 -                        # said there should be. FIXME - Warn in the log here?
 +                        # said there should be.
              $self->finalize_read;
              return;
          }
@@@ -778,10 -641,7 +783,10 @@@ there is no more data to be read
  
  =cut
  
 -sub read_chunk { }
 +sub read_chunk {
 +    my ($self, $ctx) = (shift, shift);
 +    return $self->env->{'psgi.input'}->read(@_);
 +}
  
  =head2 $self->read_length
  
@@@ -792,62 -652,13 +797,62 @@@ header
  
  The amount of input data that has already been read.
  
 -=head2 $self->run($c)
 +=head2 $self->run($app, $server)
 +
 +Start the engine. Builds a PSGI application and calls the
 +run method on the server passed in, which then causes the
 +engine to loop, handling requests..
 +
 +=cut
 +
 +sub run {
 +    my ($self, $app, $psgi, @args) = @_;
 +    # @args left here rather than just a $options, $server for back compat with the
 +    # old style scripts which send a few args, then a hashref
 +
 +    # They should never actually be used in the normal case as the Plack engine is
 +    # passed in got all the 'standard' args via the loader in the script already.
 +
 +    # FIXME - we should stash the options in an attribute so that custom args
 +    # like Gitalist's --git_dir are possible to get from the app without stupid tricks.
 +    my $server = pop @args if (scalar @args && blessed $args[-1]);
 +    my $options = pop @args if (scalar @args && ref($args[-1]) eq 'HASH');
 +    # Back compat hack for applications with old (non Catalyst::Script) scripts to work in FCGI.
 +    if (scalar @args && !ref($args[0])) {
 +        if (my $listen = shift @args) {
 +            $options->{listen} ||= [$listen];
 +        }
 +    }
 +    if (! $server ) {
 +        $server = Catalyst::EngineLoader->new(application_name => ref($self))->auto(%$options);
 +        # We're not being called from a script, so auto detect what backend to
 +        # run on.  This should never happen, as mod_perl never calls ->run,
 +        # instead the $app->handle method is called per request.
 +        $app->log->warn("Not supplied a Plack engine, falling back to engine auto-loader (are your scripts ancient?)")
 +    }
 +    $server->run($psgi, $options);
 +}
 +
 +=head2 build_psgi_app ($app, @args)
  
 -Start the engine. Implemented by the various engine classes.
 +Builds and returns a PSGI application closure, wrapping it in the reverse proxy
 +middleware if the using_frontend_proxy config setting is set.
  
  =cut
  
 -sub run { }
 +sub build_psgi_app {
 +    my ($self, $app, @args) = @_;
 +
 +    return sub {
 +        my ($env) = @_;
 +
 +        return sub {
 +            my ($respond) = @_;
 +            $self->_set_response_cb($respond);
 +            $app->handle_request(env => $env);
 +        };
 +    };
 +}
  
  =head2 $self->write($c, $buffer)
  
@@@ -863,12 -674,33 +868,12 @@@ sub write 
          $self->_prepared_write(1);
      }
  
 -    return 0 if !defined $buffer;
 +    $buffer = q[] unless defined $buffer;
  
 -    my $len   = length($buffer);
 -    my $wrote = syswrite STDOUT, $buffer;
 -
 -    if ( !defined $wrote && $! == EWOULDBLOCK ) {
 -        # Unable to write on the first try, will retry in the loop below
 -        $wrote = 0;
 -    }
 -
 -    if ( defined $wrote && $wrote < $len ) {
 -        # We didn't write the whole buffer
 -        while (1) {
 -            my $ret = syswrite STDOUT, $buffer, $CHUNKSIZE, $wrote;
 -            if ( defined $ret ) {
 -                $wrote += $ret;
 -            }
 -            else {
 -                next if $! == EWOULDBLOCK;
 -                return;
 -            }
 -
 -            last if $wrote >= $len;
 -        }
 -    }
 +    my $len = length($buffer);
 +    $self->_writer->write($buffer);
  
 -    return $wrote;
 +    return $len;
  }
  
  =head2 $self->unescape_uri($uri)
diff --combined t/live_catalyst_test.t
@@@ -1,12 -1,9 +1,12 @@@
 +use strict;
 +use warnings;
 +
  use FindBin;
  use lib "$FindBin::Bin/lib";
  use Catalyst::Test 'TestApp', {default_host => 'default.com'};
  use Catalyst::Request;
  
- use Test::More tests => 10;
+ use Test::More;
  
  content_like('/',qr/root/,'content check');
  action_ok('/','Action ok ok','normal action ok');
@@@ -43,3 -40,6 +43,6 @@@ my $req = '/dump/request'
      eval '$creq = ' . request($req, \%opts)->content;
      is( $creq->uri->host, $opts{host}, 'target host is mutable via options hashref' );
  }
+ done_testing;