fixed bugs in type constraints and cored some extensibility features
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
index f013027..27b421e 100644 (file)
@@ -63,7 +63,9 @@ has request => (
     is => 'rw',
     default => sub {
         my $self = shift;
-        $self->request_class->new($self->_build_request_constructor_args);
+        my $class = ref $self;
+        my $composed_request_class = $class->composed_request_class;
+        return $composed_request_class->new( $self->_build_request_constructor_args);
     },
     lazy => 1,
 );
@@ -77,11 +79,19 @@ sub _build_request_constructor_args {
     \%p;
 }
 
+sub composed_request_class {
+  my $class = shift;
+  return $class->_composed_request_class ||
+    $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @{$class->request_class_traits||[]}));
+}
+
 has response => (
     is => 'rw',
     default => sub {
         my $self = shift;
-        $self->response_class->new($self->_build_response_constructor_args);
+        my $class = ref $self;
+        my $composed_response_class = $class->composed_response_class;
+        return $composed_response_class->new( $self->_build_response_constructor_args);
     },
     lazy => 1,
 );
@@ -92,6 +102,12 @@ sub _build_response_constructor_args {
     };
 }
 
+sub composed_response_class {
+  my $class = shift;
+  return $class->_composed_response_class ||
+    $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @{$class->response_class_traits||[]}));
+}
+
 has namespace => (is => 'rw');
 
 sub depth { scalar @{ shift->stack || [] }; }
@@ -120,12 +136,21 @@ __PACKAGE__->mk_classdata($_)
   for qw/components arguments dispatcher engine log dispatcher_class
   engine_loader context_class request_class response_class stats_class
   setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware
-  _data_handlers _encoding _encode_check finalized_default_middleware/;
+  _data_handlers _encoding _encode_check finalized_default_middleware
+  request_class_traits response_class_traits stats_class_traits
+  _composed_request_class _composed_response_class _composed_stats_class/;
 
 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
 __PACKAGE__->request_class('Catalyst::Request');
 __PACKAGE__->response_class('Catalyst::Response');
 __PACKAGE__->stats_class('Catalyst::Stats');
+
+sub composed_stats_class {
+  my $class = shift;
+  return $class->_composed_stats_class ||
+    $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @{$class->stats_class_traits||[]}));
+}
+
 __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
 
 # Remember to update this in Catalyst::Runtime as well!
@@ -1447,6 +1472,10 @@ In general the scheme of the generated URI object will follow the incoming reque
 however if your targeted action or action chain has the Scheme attribute it will
 use that instead.
 
+Also, if the targeted Action or Action chain declares Args/CaptureArgs that have
+type constraints, we will require that your proposed URL verify on those declared
+constraints.
+
 =cut
 
 sub uri_for {
@@ -1465,44 +1494,27 @@ sub uri_for {
 
     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
 
-    my @encoded_args = ();
-    foreach my $arg (@args) {
-      if(ref($arg)||'' eq 'ARRAY') {
-        push @encoded_args, [map {
-          my $encoded = encode_utf8 $_;
-          $encoded =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
-         $encoded;
-        } @$arg];
-      } else {
-        push @encoded_args, do {
-          my $encoded = encode_utf8 $arg;
-          $encoded =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
-          $encoded;
-        }
-      }
-    }
-
     my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef;
     if ( $path->$_isa('Catalyst::Action') ) { # action object
-        s|/|%2F|g for @encoded_args;
+        s|/|%2F|g for @args;
         my $captures = [ map { s|/|%2F|g; $_; }
-                        ( scalar @encoded_args && ref $encoded_args[0] eq 'ARRAY'
-                         ? @{ shift(@encoded_args) }
+                        ( scalar @args && ref $args[0] eq 'ARRAY'
+                         ? @{ shift(@args) }
                          : ()) ];
 
         my $action = $path;
+        my $expanded_action = $c->dispatcher->expand_action( $action );
+        my $num_captures = $expanded_action->number_of_captures;
+
         # ->uri_for( $action, \@captures_and_args, \%query_values? )
-        if( !@encoded_args && $action->number_of_args ) {
-            my $expanded_action = $c->dispatcher->expand_action( $action );
-            my $num_captures = $expanded_action->number_of_captures;
-            unshift @encoded_args, splice @$captures, $num_captures;
+        if( !@args && $action->number_of_args ) {
+          unshift @args, splice @$captures, $num_captures;
         }
 
-        # use Devel::Dwarn;Dwarn $captures;
-
-        if($action->has_captures_constraints) {
-          unless($action->match_captures($c, $captures)) {
-            carp "@{$captures} do not match the type constraints in $action";
+        if($num_captures) {
+          unless($expanded_action->match_captures_constraints($c, $captures)) {
+            carp "captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'";
+            return;
           }
         }
 
@@ -1515,25 +1527,26 @@ sub uri_for {
         $path = '/' if $path eq '';
 
         # At this point @encoded_args is the remaining Args (all captures removed).
-        if($action->has_args_constraints) {
-          unless($action->match_args($c,\@encoded_args)) {
-            carp "@encoded_args do not match the type constraints in $action";
+        if($expanded_action->has_args_constraints) {
+          unless($expanded_action->match_args($c,\@args)) {
+             carp "args [@args] do not match the type constraints in action '$expanded_action'";
+             return;
           }
         }
     }
 
-    unshift(@encoded_args, $path);
+    unshift(@args, $path);
 
     unless (defined $path && $path =~ s!^/!!) { # in-place strip
         my $namespace = $c->namespace;
         if (defined $path) { # cheesy hack to handle path '../foo'
-           $namespace =~ s{(?:^|/)[^/]+$}{} while $encoded_args[0] =~ s{^\.\./}{};
+           $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
         }
-        unshift(@encoded_args, $namespace || '');
+        unshift(@args, $namespace || '');
     }
 
     # join args with '/', or a blank string
-    my $args = join('/', grep { defined($_) } @encoded_args);
+    my $args = join('/', grep { defined($_) } @args);
     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
     $args =~ s!^/+!!;
 
@@ -1582,8 +1595,10 @@ sub uri_for {
       } @keys);
     }
 
-    warn $base;
-    warn $args;
+    $base = encode_utf8 $base;
+    $base =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
+    $args = encode_utf8 $args;
+    $args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
     
     my $res = bless(\"${base}${args}${query}", $class);
     $res;
@@ -2279,8 +2294,10 @@ sub prepare {
 
     $c->response->_context($c);
 
-    #surely this is not the most efficient way to do things...
-    $c->stats($class->stats_class->new)->enable($c->use_stats);
+    if($c->use_stats) {
+      $c->stats($class->composed_stats_class->new)->enable;
+    }
+
     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
     }
@@ -2686,10 +2703,26 @@ sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
 
 Returns or sets the request class. Defaults to L<Catalyst::Request>.
 
+=head2 $app->request_class_traits
+
+An arrayref of L<Moose::Role>s which are applied to the request class.  
+
+=head2 $app->composed_request_class
+
+This is the request class which has been composed with any request_class_traits.
+
 =head2 $c->response_class
 
 Returns or sets the response class. Defaults to L<Catalyst::Response>.
 
+=head2 $app->response_class_traits
+
+An arrayref of L<Moose::Role>s which are applied to the response class.
+
+=head2 $app->composed_response_class
+
+This is the request class which has been composed with any response_class_traits.
+
 =head2 $c->read( [$maxlength] )
 
 Reads a chunk of data from the request body. This method is designed to
@@ -2807,6 +2840,15 @@ sub setup_components {
             $class->components->{ $component } = $class->setup_component($component);
         }
     }
+
+    # Inject a component or wrap a stand alone class in an adaptor
+    #my @configured_comps = grep { not($class->component($_)||'') }
+    # grep { /^(Model)::|(View)::|(Controller::)/ }
+    #   keys %{$class->config ||+{}};
+
+    #foreach my $configured_comp(@configured_comps) {
+      #warn $configured_comp;
+      #}
 }
 
 =head2 $c->locate_components( $setup_component_config )
@@ -3693,6 +3735,14 @@ by itself.
 
 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
 
+=head2 $app->stats_class_traits
+
+A arrayref of L<Moose::Role>s that are applied to the stats_class before creating it.
+
+=head2 $app->composed_stats_class
+
+this is the stats_class composed with any 'stats_class_traits'.
+
 =head2 $c->use_stats
 
 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.