Text::SimpleTable's now go as wide as $ENV{COLUMNS}

[catagits/Catalyst-Runtime.git] / lib / Catalyst / Dispatcher.pm

diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index 995cca5..b0b3606 100644 (file)
--- a/lib/Catalyst/Dispatcher.pm
+++ b/lib/Catalyst/Dispatcher.pm
@@ -10,28 +10,40 @@ use Catalyst::Action;
 use Catalyst::ActionContainer;
 use Catalyst::DispatchType::Default;
 use Catalyst::DispatchType::Index;
+use Catalyst::Utils;
 use Text::SimpleTable;
 use Tree::Simple;
 use Tree::Simple::Visitor::FindByPath;
 use Scalar::Util ();
 
-#do these belong as package vars or should we build these via a builder method?
+# Refactoring note:
+# do these belong as package vars or should we build these via a builder method?
+# See Catalyst-Plugin-Server for them being added to, which should be much less ugly.
+
 # Preload these action types
 our @PRELOAD = qw/Index Path Regex/;
 
 # Postload these action types
 our @POSTLOAD = qw/Default/;
 
+# Note - see back-compat methods at end of file.
 has _tree => (is => 'rw');
 has _dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
 has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1);
 has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
-has _action_container_class => (is => 'rw', default => 'Catalyst::ActionContainer');
+has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
+has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
 
 has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
 has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
-has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
-has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
+
+# Wrap accessors so you can assign a list and it will capture a list ref.
+around qw/preload_dispatch_types postload_dispatch_types/ => sub {
+    my $orig = shift;
+    my $self = shift;
+    return $self->$orig([@_]) if (scalar @_ && ref $_[0] ne 'ARRAY');
+    return $self->$orig(@_);
+};
 
 no Moose;
 
@@ -240,10 +252,8 @@ sub _do_forward {
 
     no warnings 'recursion';
 
-    my $orig_args = $c->request->arguments();
-    $c->request->arguments($args);
+    local $c->request->{arguments} = $args;
     $action->dispatch( $c );
-    $c->request->arguments($orig_args);
 
     return $c->state;
 }
@@ -500,7 +510,8 @@ sub register {
         next if $key eq 'Private';
         my $class = "Catalyst::DispatchType::$key";
         unless ( $registered->{$class} ) {
-            #some error checking rethrowing here wouldn't hurt.
+            # FIXME - Some error checking and re-throwing needed here, as
+            #         we eat exceptions loading dispatch types.
             eval { Class::MOP::load_class($class) };
             push( @{ $self->_dispatch_types }, $class->new ) unless $@;
             $registered->{$class} = 1;
@@ -573,10 +584,9 @@ sub setup_actions {
 
     return unless $c->debug;
 
+    my $column_width = Catalyst::Utils::term_width() - 20 - 36 - 12;
     my $privates = Text::SimpleTable->new(
-        [ 20, 'Private' ],
-        [ 36, 'Class' ],
-        [ 12, 'Method' ]
+        [ 20, 'Private' ], [ 36, 'Class' ], [ $column_width, 'Method' ]
     );
 
     my $has_private = 0;
@@ -627,6 +637,45 @@ sub _load_dispatch_types {
     return @loaded;
 }
 
+use Moose;
+
+# 5.70 backwards compatibility hacks.
+
+# Various plugins (e.g. Plugin::Server and Plugin::Authorization::ACL)
+# need the methods here which *should* be private..
+
+# However we can't really take them away until there is a sane API for
+# building actions and configuring / introspecting the dispatcher.
+# In 5.90, we should build that infrastructure, port the plugins which
+# use it, and then take the crap below away.
+# See also t/lib/TestApp/Plugin/AddDispatchTypes.pm
+
+# Alias _method_name to method_name, add a before modifier to warn..
+foreach my $public_method_name (qw/ 
+        tree 
+        dispatch_types 
+        registered_dispatch_types 
+        method_action_class  
+        action_hash 
+        container_hash
+    /) {
+    my $private_method_name = '_' . $public_method_name;
+    my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time.
+    $meta->add_method($public_method_name, $meta->get_method($private_method_name));
+    {
+        my %package_hash; # Only warn once per method, per package. These are infrequent enough that
+                          # I haven't provided a way to disable them, patches welcome.
+        $meta->add_before_method_modifier($public_method_name, sub {
+            my $class = Scalar::Util::blessed(shift);
+            $package_hash{$class}++ || do { 
+                warn("Class $class is calling the deprecated method Catalyst::Dispatcher::$public_method_name,\n"
+                    . "this will be removed in Catalyst 5.9X");
+            };
+        });
+    }
+}
+# End 5.70 backwards compatibility hacks.
+
 no Moose;
 __PACKAGE__->meta->make_immutable;