merged after conflict resolution
John Napiorkowski [Wed, 12 Jun 2013 14:27:20 +0000 (10:27 -0400)]
17 files changed:
Changes
Makefile.PL
lib/Catalyst.pm
lib/Catalyst/Action.pm
lib/Catalyst/ActionChain.pm
lib/Catalyst/Controller.pm
lib/Catalyst/DispatchType/Chained.pm
lib/Catalyst/Engine.pm
lib/Catalyst/Request.pm
lib/Catalyst/Response.pm
lib/Catalyst/Upgrading.pod
t/aggregate/live_component_controller_action_chained.t
t/author/http-server.t
t/author/spelling.t
t/dead_load_bad_args.t
t/lib/TestApp.pm
t/lib/TestApp/Controller/Action/Chained.pm

diff --git a/Changes b/Changes
index 115949c..1d75d76 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,7 +1,29 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+TBA
+  ! Stricter checking of attributes in Catalyst::DispatchType::Chained:
+    1) Only allow one of either :CaptureArgs or :Args
+    2) :CaptureArgs() argument must be numeric
+    3) :CaptureArgs() and :Args() arguments cannot be negative
   - Add Devel::InnerPackage to dependencies, fixing tests on perl 5.17.11
     as it's been removed from core. RT#84787
+  - New support for closing over the PSGI $writer object, useful for working
+    with event loops.
+  - lets you access a psgix.io socket, if your server supports it, for manual
+    handling of the client - server communication, such as for websockets.
+  - Fix waiting for the server to start in t/author/http-server.t
+  - new config flag 'abort_chain_on_error_fix' that exits immediately when a
+    action in an action chain throws and error (fixes issues where currently
+    the remaining actions are processed and the error is handled at chain
+    termination).
+  - Cored the Encoding plugin.  Now get unicode out of the box by just setting
+    $c->config->{encoding} = 'UTF-8'.  BACKCOMPAT WARNING: If you are using 
+    the Encoding plugin on CPAN, we skip it to avoid double encoding issues, so
+    you should remove it from your plugin list, HOWEVER the 'encoding' config
+    setting is now undef, rather than 'UTF-8' (this was done to avoid breaking
+    people's existing applications) so you should add the encoding setting to 
+    you global config (See Catalyst::Upgrading for more).
+  - minor documentation typo fixes and updates
 
 5.90030 - 2013-04-12
   ! POSSIBLE BREAKING CHANGE: Removed Regexp dispatch type from core, and put
index 382ad89..b50b74f 100644 (file)
@@ -98,6 +98,7 @@ else {
 push(@author_requires, 'CatalystX::LeakChecker', '0.05');
 push(@author_requires, 'Catalyst::Devel', '1.0'); # For http server test
 push(@author_requires, 'Test::WWW::Mechanize::Catalyst', '0.51');
+push(@author_requires, 'Test::TCP', '1.27'); # ditto, ships Net::EmptyPort
 
 author_tests('t/author');
 author_requires(
@@ -125,6 +126,7 @@ resources(
     'IRC'         => 'irc://irc.perl.org/#catalyst',
     'license',    => 'http://dev.perl.org/licenses/',
     'homepage',   => 'http://dev.catalyst.perl.org/',
+    # r/w: catagits@git.shadowcat.co.uk:Catalyst-Runtime.git
     'repository', => 'git://git.shadowcat.co.uk/catagits/Catalyst-Runtime.git',
 );
 
index a6170d3..17605d4 100644 (file)
@@ -1793,6 +1793,14 @@ sub finalize {
         $c->log->error($error);
     }
 
+    # Support skipping finalize for psgix.io style 'jailbreak'.  Used to support
+    # stuff like cometd and websockets
+    
+    if($c->request->has_io_fh) {
+      $c->log_response;
+      return;
+    }
+
     # Allow engine to handle finalize flow (for POE)
     my $engine = $c->engine;
     if ( my $code = $engine->can('finalize') ) {
@@ -3197,6 +3205,17 @@ C<encoding> - See L</ENCODING>
 
 =back
 
+=item abort_chain_on_error_fix => 1
+
+When there is an error in an action chain, the default behavior is to continue
+processing the remaining actions and then catch the error upon chain end.  This
+can lead to running actions when the application is in an unexpected state.  If
+you have this issue, setting this config value to true will promptly exit a
+chain when there is an error raised in any action (thus terminating the chain 
+early.)
+
+In the future this might become the default behavior.
+
 =head1 INTERNAL ACTIONS
 
 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
index d360d68..555c939 100644 (file)
@@ -127,7 +127,7 @@ and so on. This determines how the action is dispatched to.
 =head2 class
 
 Returns the name of the component where this action is defined.
-Derived by calling the L<Catalyst::Component/catalyst_component_name|catalyst_component_name>
+Derived by calling the L<catalyst_component_name|Catalyst::Component/catalyst_component_name>
 method on each component.
 
 =head2 code
index 496000b..ed2fb51 100644 (file)
@@ -34,6 +34,9 @@ sub dispatch {
         }
         local $c->request->{arguments} = \@args;
         $action->dispatch( $c );
+
+        # break the chain if exception occurs in the middle of chain
+        return if (@{$c->error} && $c->config->{abort_chain_on_error_fix});
     }
     $last->dispatch( $c );
 }
index 28b54be..99c2893 100644 (file)
@@ -740,7 +740,7 @@ Handle various types of paths:
     ...
 
     sub myaction1 :Path { ... }  # -> /baz
-    sub myaction2 :Path('foo') { ... } # -> /baz/bar
+    sub myaction2 :Path('foo') { ... } # -> /baz/foo
     sub myaction2 :Path('/bar') { ... } # -> /bar
   }
 
index 44f890e..33e23d2 100644 (file)
@@ -285,6 +285,32 @@ Calls register_path for every Path attribute for the given $action.
 
 =cut
 
+sub _check_args_attr {
+    my ( $self, $action, $name ) = @_;
+
+    return unless exists $action->attributes->{$name};
+
+    if (@{$action->attributes->{$name}} > 1) {
+        Catalyst::Exception->throw(
+          "Multiple $name attributes not supported registering " . $action->reverse()
+        );
+    }
+    my $args = $action->attributes->{$name}->[0];
+    if (defined($args) and not (
+        Scalar::Util::looks_like_number($args) and
+        int($args) == $args and $args >= 0
+    )) {
+        require Data::Dumper;
+        local $Data::Dumper::Terse = 1;
+        local $Data::Dumper::Indent = 0;
+        $args = Data::Dumper::Dumper($args);
+        Catalyst::Exception->throw(
+          "Invalid $name($args) for action " . $action->reverse() .
+          " (use '$name' or '$name(<number>)')"
+        );
+    }
+}
+
 sub register {
     my ( $self, $c, $action ) = @_;
 
@@ -329,21 +355,15 @@ sub register {
 
     $self->_actions->{'/'.$action->reverse} = $action;
 
-    if (exists $action->attributes->{Args}) {
-        my $args = $action->attributes->{Args}->[0];
-        if (defined($args) and not (
-            Scalar::Util::looks_like_number($args) and
-            int($args) == $args
-        )) {
-            require Data::Dumper;
-            local $Data::Dumper::Terse = 1;
-            local $Data::Dumper::Indent = 0;
-            $args = Data::Dumper::Dumper($args);
-            Catalyst::Exception->throw(
-              "Invalid Args($args) for action " . $action->reverse() .
-              " (use 'Args' or 'Args(<number>)')"
-            );
-        }
+    foreach my $name (qw(Args CaptureArgs)) {
+        $self->_check_args_attr($action, $name);
+    }
+
+    if (exists $action->attributes->{Args} and exists $action->attributes->{CaptureArgs}) {
+        Catalyst::Exception->throw(
+          "Combining Args and CaptureArgs attributes not supported registering " .
+          $action->reverse()
+        );
     }
 
     unless ($action->attributes->{CaptureArgs}) {
index 2367139..fc55db7 100644 (file)
@@ -54,12 +54,20 @@ See L<Catalyst>.
 
 =head2 $self->finalize_body($c)
 
-Finalize body.  Prints the response output.
+Finalize body.  Prints the response output as blocking stream if it looks like
+a filehandle, otherwise write it out all in one go.  If there is no body in
+the response, we assume you are handling it 'manually', such as for nonblocking
+style or asynchronous streaming responses.  You do this by calling L<\write>
+several times (which sends HTTP headers if needed) or you close over C<$response->write_fh>.
+
+See L<Catalyst::Response\write> and L<Catalyst::Response\write_fh> for more.
 
 =cut
 
 sub finalize_body {
     my ( $self, $c ) = @_;
+    return if $c->response->has_write_fh;
+
     my $body = $c->response->body;
     no warnings 'uninitialized';
     if ( blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) {
@@ -685,7 +693,7 @@ sub build_psgi_app {
 
         return sub {
             my ($respond) = @_;
-            confess("Did not get a response callback for writer, cannot continiue") unless $respond;
+            confess("Did not get a response callback for writer, cannot continue") unless $respond;
             $app->handle_request(env => $env, response_cb => $respond);
         };
     };
index b8d05b4..17f0be9 100644 (file)
@@ -91,6 +91,19 @@ has _log => (
     required => 1,
 );
 
+has io_fh => (
+  is=>'ro',
+  predicate=>'has_io_fh',
+  lazy=>1,
+  builder=>'_build_io_fh');
+
+  sub _build_io_fh {
+    my $self = shift;
+    return $self->env->{'psgix.io'}
+      || die "Your Server does not support psgix.io";
+  };
+
+
 # Amount of data to read from input on each pass
 our $CHUNKSIZE = 64 * 1024;
 
@@ -640,7 +653,7 @@ defaults to the size of the request if not specified.
 
 =head2 $req->read_chunk(\$buff, $max)
 
-Reads a chunk..
+Reads a chunk.
 
 You have to set MyApp->config(parse_on_demand => 1) to use this directly.
 
@@ -651,10 +664,12 @@ Shortcut for $req->headers->referer. Returns the referring page.
 =head2 $req->secure
 
 Returns true or false, indicating whether the connection is secure
-(https). Note that the URI scheme (e.g., http vs. https) must be determined
-through heuristics, and therefore the reliability of $req->secure will depend
-on your server configuration. If you are setting the HTTPS environment variable, 
-$req->secure should be valid.
+(https). The reliability of $req->secure may depend on your server
+configuration; Catalyst relies on PSGI to determine whether or not a
+request is secure (Catalyst looks at psgi.url_scheme), and different
+PSGI servers may make this determination in different ways (as by
+directly passing along information from the server, interpreting any of
+several HTTP headers, or using heuristics of their own).
 
 =head2 $req->captures
 
@@ -844,6 +859,12 @@ Returns the value of the C<REMOTE_USER> environment variable.
 Shortcut to $req->headers->user_agent. Returns the user agent (browser)
 version string.
 
+=head2 $req->io_fh
+
+Returns a psgix.io bidirectional socket, if your server supports one.  Used for
+when you want to jailbreak out of PSGI and handle bidirectional client server
+communication manually, such as when you are using cometd or websockets.
+
 =head1 SETUP METHODS
 
 You should never need to call these yourself in application code,
index 6dc661e..1db5666 100644 (file)
@@ -26,7 +26,27 @@ has _writer => (
     predicate => '_has_writer',
 );
 
-sub DEMOLISH { $_[0]->_writer->close if $_[0]->_has_writer }
+has write_fh => (
+  is=>'ro',
+  predicate=>'has_write_fh',
+  lazy=>1,
+  builder=>'_build_write_fh',
+);
+
+sub _build_write_fh {
+  my $self = shift;
+  $self->_context->finalize_headers unless
+    $self->finalized_headers;
+  $self->_writer;
+};
+
+sub DEMOLISH {
+  my $self = shift;
+  return if $self->has_write_fh;
+  if($self->_has_writer) {
+    $self->_writer->close
+  }
+}
 
 has cookies   => (is => 'rw', default => sub { {} });
 has body      => (is => 'rw', default => undef);
@@ -246,6 +266,40 @@ $res->code is an alias for this, to match HTTP::Response->code.
 
 Writes $data to the output stream.
 
+=head2 $res->write_fh
+
+Returns a PSGI $writer object that has two methods, write and close.  You can
+close over this object for asynchronous and nonblocking applications.  For
+example (assuming you are using a supporting server, like L<Twiggy>
+
+    package AsyncExample::Controller::Root;
+
+    use Moose;
+
+    BEGIN { extends 'Catalyst::Controller' }
+
+    sub prepare_cb {
+      my $write_fh = pop;
+      return sub {
+        my $message = shift;
+        $write_fh->write("Finishing: $message\n");
+        $write_fh->close;
+      };
+    }
+
+    sub anyevent :Local :Args(0) {
+      my ($self, $c) = @_;
+      my $cb = $self->prepare_cb($c->res->write_fh);
+
+      my $watcher;
+      $watcher = AnyEvent->timer(
+        after => 5,
+        cb => sub {
+          $cb->(scalar localtime);
+          undef $watcher; # cancel circular-ref
+        });
+    }
+
 =head2 $res->print( @data )
 
 Prints @data to the output stream, separated by $,.  This lets you pass
index b6d3c8b..7d45923 100644 (file)
@@ -2,6 +2,52 @@
 
 Catalyst::Upgrading - Instructions for upgrading to the latest Catalyst
 
+=head1 Upgrading to Catalyst TBA
+
+=head2 Catalyst::Plugin::Unicode::Encoding is now core
+
+The previously stand alone Unicode support module L<Catalyst::Plugin::Unicode::Encoding>
+has been brought into core as a default plugin.  Going forward, all you need is
+to add a configuration setting for the encoding type.  For example:
+
+    package Myapp::Web;
+
+    use Catalyst;
+
+    __PACKAGE__->config( encoding => 'UTF-8' );
+
+Please note that this is different from the old stand alone plugin which applied
+C<UTF-8> encoding by default (that is, if you did not set an explicit
+C<encoding> configuration value, it assumed you wanted UTF-8).  In order to 
+preserve backwards compatibility you will need to explicitly turn it on via the
+configuration setting.  THIS MIGHT CHANGE IN THE FUTURE, so please consider
+starting to test your application with proper UTF-8 support and remove all those
+crappy hacks you munged into the code because you didn't know the Plugin
+existed :)
+
+For people that are using the Plugin, you will note a startup warning suggesting
+that you can remove it from the plugin list.  When you do so, please remember to
+add the configuration setting, since you can no longer rely on the default being
+UTF-8.  We'll add it for you if you continue to use the stand alone plugin and
+we detect this, but this backwards compatibility shim will likely be removed in
+a few releases (trying to clean up the codebase after all).
+
+If you have trouble with any of this, please bring it to the attention of the
+Catalyst maintainer group.
+
+=head2 basic async and event loop support
+
+This version of L<Catalyst> offers some support for using L<AnyEvent> and
+L<IO::Async> event loops in your application.  These changes should work
+fine for most applications however if you are already trying to perform
+some streaming, minor changes in this area of the code might affect your
+functionality.  Please see L<Catalyst::Response\write_fh> for more and for a
+basic example.
+
+We consider this feature experimental.  We will try not to break it, but we
+reserve the right to make necessary changes to fix major issues that people
+run into when the use this functionality in the wild.
+
 =head1 Upgrading to Catalyst 5.9
 
 The major change is that L<Plack>, a toolkit for using the L<PSGI>
index d6fcfed..0cebe9b 100644 (file)
@@ -773,6 +773,25 @@ sub run_tests {
     }
 
     #
+    # Test throwing an error in the middle of a chain.
+    #
+    {
+        my @expected = qw[
+          TestApp::Controller::Action::Chained->begin
+          TestApp::Controller::Action::Chained->chain_die_a
+          TestApp::Controller::Action::Chained->end
+        ];
+
+        my $expected = join( ", ", @expected );
+
+        ok( my $response = request('http://localhost/chained/chain_die/1/end/2'),
+            "Break a chain in the middle" );
+        is( $response->header('X-Catalyst-Executed'),
+            $expected, 'Executed actions' );
+        is( $response->content, 'FATAL ERROR: break in the middle of a chain', 'Content OK' );
+    }
+
+    #
     #   Tests that an uri_for to a chained root index action
     #   returns the right value.
     #
index ead1cad..7f886ca 100644 (file)
@@ -5,7 +5,7 @@ use Test::More tests => 1;
 
 use File::Path;
 use FindBin;
-use Test::TCP;
+use Net::EmptyPort qw(wait_port empty_port);
 use Try::Tiny;
 use Plack::Builder;
 
@@ -96,10 +96,7 @@ if ($^O eq 'MSWin32') {
 sub wait_port_timeout {
     my ($port, $timeout) = @_;
 
-    # wait_port waits for 10 seconds
-    for (1 .. int($timeout / 10)) { # meh, good enough.
-        try { wait_port $port; 1 } and return;
-    }
+    wait_port($port, 0.1, $timeout * 10) and return;
 
     die "Server did not start within $timeout seconds";
 }
index 4213b3b..465c5eb 100644 (file)
@@ -18,7 +18,7 @@ add_stopwords(qw(
     wiki bitmask uri url urls dir hostname proxied http https IP SSL
     inline INLINE plugins cpanfile
     FastCGI Stringifies Rethrows DispatchType Wishlist Refactor ROADMAP HTTPS Unescapes Restarter Nginx Refactored
-    ActionClass LocalRegex LocalRegexp MyAction metadata
+    ActionClass LocalRegex LocalRegexp MyAction metadata cometd io psgix websockets
     Andreas
     Ashton
     Axel
index 67fe64b..d80195f 100644 (file)
@@ -6,26 +6,26 @@ use lib 't/lib';
 
 use Test::More;
 
-plan tests => 16;
-
 use Catalyst::Test 'TestApp';
 
 for my $fail (
     "(' ')",
     "('')",
     "('1.23')",
+    "(-1)",
 ) {
-
-    eval <<"END";
-        package TestApp::Controller::Action::Chained;
-        no warnings 'redefine';
-        sub should_fail : Chained('/') Args$fail {}
+    for my $type (qw(Args CaptureArgs)) {
+        eval <<"END";
+            package TestApp::Controller::Action::Chained;
+            no warnings 'redefine';
+            sub should_fail : Chained('/') ${type}${fail} {}
 END
-    ok(!$@);
+        ok(!$@);
 
-    eval { TestApp->setup_actions };
-    like($@, qr/Invalid Args\Q$fail\E/,
-        "Bad Args$fail attribute makes action setup fail");
+        eval { TestApp->setup_actions };
+        like($@, qr/Invalid \Q${type}${fail}\E/,
+             "Bad ${type}${fail} attribute makes action setup fail");
+    }
 }
 
 for my $ok (
@@ -35,12 +35,33 @@ for my $ok (
     "('0')",
     "",
 ) {
-    eval <<"END";
-        package TestApp::Controller::Action::Chained;
-        no warnings 'redefine';
-        sub should_fail : Chained('/') Args$ok {}
+    for my $type (qw(Args CaptureArgs)) {
+        eval <<"END";
+            package TestApp::Controller::Action::Chained;
+            no warnings 'redefine';
+            sub should_fail : Chained('/') ${type}${ok} {}
+END
+        ok(!$@);
+        eval { TestApp->setup_actions };
+        ok(!$@, "${type}${ok} works");
+    }
+}
+
+for my $first (qw(Args CaptureArgs)) {
+    for my $second (qw(Args CaptureArgs)) {
+        eval <<"END";
+            package TestApp::Controller::Action::Chained;
+            no warnings 'redefine';
+            sub should_fail :Chained('/') $first $second {}
 END
-    ok(!$@);
-    eval { TestApp->setup_actions };
-    ok(!$@, "Args$ok works");
+        ok(!$@);
+        eval { TestApp->setup_actions };
+        my $msg = $first eq $second
+           ? "Multiple $first"
+           : "Combining Args and CaptureArgs";
+        like($@, qr/$msg attributes not supported registering/,
+             "$first + $second attribute makes action setup fail");
+    }
 }
+
+done_testing();
index c1ec9b5..b06880c 100644 (file)
@@ -51,6 +51,7 @@ TestApp->config(
         }
     },
     encoding => 'UTF-8',
+    abort_chain_on_error_fix => 1,
 );
 
 # Test bug found when re-adjusting the metaclass compat code in Moose
index 5fa5f22..2af1ec6 100644 (file)
@@ -143,6 +143,15 @@ sub chain_dt_a :Chained :PathPart('chained/chain_dt') :CaptureArgs(1) {
 sub chain_dt_b :Chained('chain_dt_a') :PathPart('end') :Args(1) { }
 
 #
+#   Die in the middle of a chain
+#
+sub chain_die_a :Chained :PathPart('chained/chain_die') :CaptureArgs(1) {
+    $_[1]->error( 'break in the middle of a chain' );
+}
+
+sub chain_die_b :Chained('chain_die_a') :PathPart('end') :Args(1) {}
+
+#
 #   Target for former forward and chain tests.
 #
 sub fw_dt_target :Private { }