compose req/res/stats class much much ;ater
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
index 016ef2d..9c3c7ef 100644 (file)
@@ -81,9 +81,27 @@ sub _build_request_constructor_args {
 
 sub composed_request_class {
   my $class = shift;
+  return $class->_composed_request_class if $class->_composed_request_class;
+
   my @traits = (@{$class->request_class_traits||[]}, @{$class->config->{request_class_traits}||[]});
-  return $class->_composed_request_class ||
-    $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @traits));
+
+  # For each trait listed, figure out what the namespace is.  First we try the $trait
+  # as it is in the config.  Then try $MyApp::TraitFor::Request:$trait. Last we try
+  # Catalyst::TraitFor::Request::$trait.  If none load, throw error.
+
+  my $trait_ns = 'TraitFor::Request';
+  my @normalized_traits = map {
+    Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
+  } @traits;
+
+  if ($class->debug && scalar(@normalized_traits)) {
+      my $column_width = Catalyst::Utils::term_width() - 6;
+      my $t = Text::SimpleTable->new($column_width);
+      $t->row($_) for @normalized_traits;
+      $class->log->debug( "Composed Request Class Traits:\n" . $t->draw . "\n" );
+  }
+
+  return $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @normalized_traits));
 }
 
 has response => (
@@ -105,9 +123,23 @@ sub _build_response_constructor_args {
 
 sub composed_response_class {
   my $class = shift;
+  return $class->_composed_response_class if $class->_composed_response_class;
+  
   my @traits = (@{$class->response_class_traits||[]}, @{$class->config->{response_class_traits}||[]});
-  return $class->_composed_response_class ||
-    $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @traits));
+
+  my $trait_ns = 'TraitFor::Response';
+  my @normalized_traits = map {
+    Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
+  } @traits;
+
+  if ($class->debug && scalar(@normalized_traits)) {
+      my $column_width = Catalyst::Utils::term_width() - 6;
+      my $t = Text::SimpleTable->new($column_width);
+      $t->row($_) for @normalized_traits;
+      $class->log->debug( "Composed Response Class Traits:\n" . $t->draw . "\n" );
+  }
+
+  return $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @normalized_traits));
 }
 
 has namespace => (is => 'rw');
@@ -132,7 +164,8 @@ our $RECURSION = 1000;
 our $DETACH    = Catalyst::Exception::Detach->new;
 our $GO        = Catalyst::Exception::Go->new;
 
-#I imagine that very few of these really need to be class variables. if any.
+#I imagine that very few of these really 
+#need to be class variables. if any.
 #maybe we should just make them attributes with a default?
 __PACKAGE__->mk_classdata($_)
   for qw/components arguments dispatcher engine log dispatcher_class
@@ -149,15 +182,29 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 sub composed_stats_class {
   my $class = shift;
+  return $class->_composed_stats_class if $class->_composed_stats_class;
+
   my @traits = (@{$class->stats_class_traits||[]}, @{$class->config->{stats_class_traits}||[]});
-  return $class->_composed_stats_class ||
-    $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @traits));
+
+  my $trait_ns = 'TraitFor::Stats';
+  my @normalized_traits = map {
+    Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
+  } @traits;
+
+  if ($class->debug && scalar(@normalized_traits)) {
+      my $column_width = Catalyst::Utils::term_width() - 6;
+      my $t = Text::SimpleTable->new($column_width);
+      $t->row($_) for @normalized_traits;
+      $class->log->debug( "Composed Stats Class Traits:\n" . $t->draw . "\n" );
+  }
+
+  return $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @normalized_traits));
 }
 
 __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
 
 # Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90091';
+our $VERSION = '5.90105';
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 sub import {
@@ -498,7 +545,7 @@ L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
 C<< $c->go >> will perform a full dispatch on the specified action or method,
 with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
 C<go> escapes the processing of the current request chain on completion, and
-does not return to its cunless blessed $cunless blessed $caller.
+does not return to its caller.
 
 @arguments are arguments to the final destination of $action. @captures are
 arguments to the intermediate steps, if any, on the way to the final sub of
@@ -583,13 +630,17 @@ sub error {
     return $c->{error} || [];
 }
 
-
 =head2 $c->state
 
 Contains the return value of the last executed action.
 Note that << $c->state >> operates in a scalar context which means that all
 values it returns are scalar.
 
+Please note that if an action throws an exception, the value of state
+should no longer be considered the return if the last action.  It is generally
+going to be 0, which indicates an error state.  Examine $c->error for error
+details.
+
 =head2 $c->clear_errors
 
 Clear errors.  You probably don't want to clear the errors unless you are
@@ -617,22 +668,42 @@ sub has_errors { scalar(@{shift->error}) ? 1:0 }
 =head2 $c->last_error
 
 Returns the most recent error in the stack (the one most recently added...)
-or nothing if there are no errors.
+or nothing if there are no errors.  This does not modify the contents of the
+error stack.
 
 =cut
 
-sub last_error { my ($err, @errs) = @{shift->error}; return $err }
+sub last_error {
+  my (@errs) = @{shift->error};
+  return scalar(@errs) ? $errs[-1]: undef;
+}
 
 =head2 shift_errors
 
-shifts the most recently added error off the error stack and returns if.  Returns
+shifts the most recently added error off the error stack and returns it.  Returns
 nothing if there are no more errors.
 
 =cut
 
 sub shift_errors {
     my ($self) = @_;
-    my ($err, @errors) = @{$self->error};
+    my @errors = @{$self->error};
+    my $err = shift(@errors);
+    $self->{error} = \@errors;
+    return $err;
+}
+
+=head2 pop_errors
+
+pops the most recently added error off the error stack and returns it.  Returns
+nothing if there are no more errors.
+
+=cut
+
+sub pop_errors {
+    my ($self) = @_;
+    my @errors = @{$self->error};
+    my $err = pop(@errors);
     $self->{error} = \@errors;
     return $err;
 }
@@ -764,6 +835,11 @@ sub controller {
             my $comps = $c->components;
             my $check = $appclass."::Controller::".$name;
             return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+            foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) {
+                next unless $path =~ /.*::Controller/;
+                $check = $path."::".$name;
+                return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+            }
         }
         my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
@@ -803,6 +879,11 @@ sub model {
             my $comps = $c->components;
             my $check = $appclass."::Model::".$name;
             return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+            foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) {
+                next unless $path =~ /.*::Model/;
+                $check = $path."::".$name;
+                return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+            }
         }
         my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
@@ -867,6 +948,11 @@ sub view {
             else {
                 $c->log->warn( "Attempted to use view '$check', but does not exist" );
             }
+            foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) {
+                next unless $path =~ /.*::View/;
+                $check = $path."::".$name;
+                return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
+            }
         }
         my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
@@ -1411,6 +1497,11 @@ EOF
         $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
     }
 
+    # call these so we pre setup the composed classes
+    $class->composed_request_class;
+    $class->composed_response_class;
+    $class->composed_stats_class;
+
     $class->setup_finalize;
 
     # Flush the log for good measure (in case something turned off 'autoflush' early)
@@ -1441,11 +1532,11 @@ sub setup_finalize {
     $class->setup_finished(1);
 }
 
-=head2 $c->uri_for( $path?, @args?, \%query_values? )
+=head2 $c->uri_for( $path?, @args?, \%query_values?, \$fragment? )
 
-=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
+=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values?, \$fragment? )
 
-=head2 $c->uri_for( $action, [@captures, @args], \%query_values? )
+=head2 $c->uri_for( $action, [@captures, @args], \%query_values?, \$fragment? )
 
 Constructs an absolute L<URI> object based on the application root, the
 provided path, and the additional arguments and query parameters provided.
@@ -1463,6 +1554,15 @@ relative to the application root (if it does). It is then merged with
 C<< $c->request->base >>; any C<@args> are appended as additional path
 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
 
+B<NOTE> If you are using this 'stringy' first argument, we skip encoding and
+allow you to declare something like:
+
+    $c->uri_for('/foo/bar#baz')
+
+Where 'baz' is a URI fragment.  We consider this first argument string to be
+'expert' mode where you are expected to create a valid URL and we for the most
+part just pass it through without a lot of internal effort to escape and encode.
+
 If the first argument is a L<Catalyst::Action> it represents an action which
 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
 optional C<\@captures> argument (an arrayref) allows passing the captured
@@ -1505,11 +1605,24 @@ sub uri_for {
         $path .= '/';
     }
 
-    undef($path) if (defined $path && $path eq '');
+    my $fragment =  ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? pop @args : undef );
+
+    unless(blessed $path) {
+      if (defined($path) and $path =~ s/#(.+)$//)  {
+        if(defined($1) and $fragment) {
+          carp "Abiguious fragment declaration: You cannot define a fragment in '$path' and as an argument '$fragment'";
+        }
+        if(defined($1)) {
+          $fragment = $1;
+        }
+      }
+    }
 
     my $params =
       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
 
+    undef($path) if (defined $path && $path eq '');
+
     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
 
     my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef;
@@ -1588,7 +1701,6 @@ sub uri_for {
     }
 
     my $query = '';
-
     if (my @keys = keys %$params) {
       # somewhat lifted from URI::_query's query_form
       $query = '?'.join('&', map {
@@ -1617,7 +1729,16 @@ sub uri_for {
     $base =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
     $args = encode_utf8 $args;
     $args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
-    
+
+    if(defined $fragment) {
+      if(blessed $path) {
+        $fragment = encode_utf8(${$fragment});
+        $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
+        $fragment =~ s/ /+/g;
+      }
+      $query .= "#$fragment";
+    }
+
     my $res = bless(\"${base}${args}${query}", $class);
     $res;
 }
@@ -1913,7 +2034,7 @@ via $c->error.
 sub execute {
     my ( $c, $class, $code ) = @_;
     $class = $c->component($class) || $class;
-    $c->state(0);
+    #$c->state(0);
 
     if ( $c->depth >= $RECURSION ) {
         my $action = $code->reverse();
@@ -1965,7 +2086,7 @@ sub execute {
             }
             $c->error($error);
         }
-        $c->state(0);
+        #$c->state(0);
     }
     return $c->state;
 }
@@ -2205,9 +2326,10 @@ sub finalize_encoding {
         # Set the charset if necessary.  This might be a bit bonkers since encodable response
         # is false when the set charset is not the same as the encoding mimetype (maybe 
         # confusing action at a distance here..
-        # Don't try to set the charset if one already exists
+        # Don't try to set the charset if one already exists or if headers are already finalized
         $c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name)
-          unless($c->res->content_type_charset);
+          unless($c->res->content_type_charset ||
+                ($c->res->_context && $c->res->finalized_headers && !$c->res->_has_response_cb));
     }
 }
 
@@ -2311,7 +2433,6 @@ sub prepare {
     my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
 
     $c->response->_context($c);
-
     $c->stats($class->stats_class->new)->enable($c->use_stats);
 
     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
@@ -2721,8 +2842,27 @@ 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.  
+An arrayref of L<Moose::Role>s which are applied to the request class.  You can
+name the full namespace of the role, or a namespace suffix, which will then
+be tried against the following standard namespace prefixes.
+
+    $MyApp::TraitFor::Request::$trait_suffix
+    Catalyst::TraitFor::Request::$trait_suffix
+
+So for example if you set:
+
+    MyApp->request_class_traits(['Foo']);
 
+We try each possible role in turn (and throw an error if none load)
+
+    Foo
+    MyApp::TraitFor::Request::Foo
+    Catalyst::TraitFor::Request::Foo
+
+The namespace part 'TraitFor::Request' was chosen to assist in backwards
+compatibility with L<CatalystX::RoleApplicator> which previously provided
+these features in a stand alone package.
+  
 =head2 $app->composed_request_class
 
 This is the request class which has been composed with any request_class_traits.
@@ -2733,7 +2873,27 @@ 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.
+An arrayref of L<Moose::Role>s which are applied to the response class.  You can
+name the full namespace of the role, or a namespace suffix, which will then
+be tried against the following standard namespace prefixes.
+
+    $MyApp::TraitFor::Response::$trait_suffix
+    Catalyst::TraitFor::Response::$trait_suffix
+
+So for example if you set:
+
+    MyApp->response_class_traits(['Foo']);
+
+We try each possible role in turn (and throw an error if none load)
+
+    Foo
+    MyApp::TraitFor::Response::Foo
+    Catalyst::TraitFor::Responset::Foo
+
+The namespace part 'TraitFor::Response' was chosen to assist in backwards
+compatibility with L<CatalystX::RoleApplicator> which previously provided
+these features in a stand alone package.
+
 
 =head2 $app->composed_response_class
 
@@ -2854,10 +3014,10 @@ sub setup_components {
     # of named components in the configuration that are not actually existing (not a
     # real file).
 
-    $class->setup_injected_components;
+    my @injected = $class->setup_injected_components;
 
     # All components are registered, now we need to 'init' them.
-    foreach my $component_name (keys %{$class->components||+{}}) {
+    foreach my $component_name (@comps, @injected) {
       $class->components->{$component_name} = $class->components->{$component_name}->() if
         (ref($class->components->{$component_name}) || '') eq 'CODE';
     }
@@ -2878,6 +3038,9 @@ sub setup_injected_components {
           $injected_comp_name,
           $class->config->{inject_components}->{$injected_comp_name});
     }
+
+    return map { $class ."::" . $_ }
+      @injected_components;
 }
 
 =head2 $app->setup_injected_component( $injected_component_name, $config )
@@ -2974,7 +3137,7 @@ sub locate_components {
     my $config = shift;
 
     my @paths   = qw( ::M ::Model ::V ::View ::C ::Controller );
-    my $extra   = delete $config->{ search_extra } || [];
+    my $extra   = $config->{ search_extra } || [];
 
     unshift @paths, @$extra;
 
@@ -3898,7 +4061,26 @@ A arrayref of L<Moose::Role>s that are applied to the stats_class before creatin
 
 =head2 $app->composed_stats_class
 
-this is the stats_class composed with any 'stats_class_traits'.
+this is the stats_class composed with any 'stats_class_traits'.  You can
+name the full namespace of the role, or a namespace suffix, which will then
+be tried against the following standard namespace prefixes.
+
+    $MyApp::TraitFor::Stats::$trait_suffix
+    Catalyst::TraitFor::Stats::$trait_suffix
+
+So for example if you set:
+
+    MyApp->stats_class_traits(['Foo']);
+
+We try each possible role in turn (and throw an error if none load)
+
+    Foo
+    MyApp::TraitFor::Stats::Foo
+    Catalyst::TraitFor::Stats::Foo
+
+The namespace part 'TraitFor::Stats' was chosen to assist in backwards
+compatibility with L<CatalystX::RoleApplicator> which previously provided
+these features in a stand alone package.
 
 =head2 $c->use_stats
 
@@ -4110,7 +4292,7 @@ backwardly compatible).
 
 C<skip_complex_post_part_handling>
 
-When creating body parameters from a POST, if we run into a multpart POST
+When creating body parameters from a POST, if we run into a multipart POST
 that does not contain uploads, but instead contains inlined complex data
 (very uncommon) we cannot reliably convert that into field => value pairs.  So
 instead we create an instance of L<Catalyst::Request::PartData>.  If this causes
@@ -4132,9 +4314,9 @@ parameter to true.
 C<do_not_decode_query>
 
 If true, then do not try to character decode any wide characters in your
-request URL query or keywords.  Most readings of the relevent specifications
+request URL query or keywords.  Most readings of the relevant specifications
 suggest these should be UTF-* encoded, which is the default that L<Catalyst>
-will use, hwoever if you are creating a lot of URLs manually or have external
+will use, however if you are creating a lot of URLs manually or have external
 evil clients, this might cause you trouble.  If you find the changes introduced
 in Catalyst version 5.90080+ break some of your query code, you may disable 
 the UTF-8 decoding globally using this configuration.
@@ -4147,7 +4329,7 @@ C<decode_query_using_global_encoding>
 C<default_query_encoding>
 
 By default we decode query and keywords in your request URL using UTF-8, which
-is our reading of the relevent specifications.  This setting allows one to
+is our reading of the relevant specifications.  This setting allows one to
 specify a fixed value for how to decode your query.  You might need this if
 you are doing a lot of custom encoding of your URLs and not using UTF-8.
 
@@ -4184,19 +4366,19 @@ C<data_handlers> - See L<DATA HANDLERS>.
 
 C<stats_class_traits>
 
-An arrayref of L<Moose::Role>s that get componsed into your stats class.
+An arrayref of L<Moose::Role>s that get composed into your stats class.
 
 =item *
 
 C<request_class_traits>
 
-An arrayref of L<Moose::Role>s that get componsed into your request class.
+An arrayref of L<Moose::Role>s that get composed into your request class.
 
 =item *
 
 C<response_class_traits>
 
-An arrayref of L<Moose::Role>s that get componsed into your response class.
+An arrayref of L<Moose::Role>s that get composed into your response class.
 
 =item *
 
@@ -4675,6 +4857,8 @@ Caelum: Rafael Kitover <rkitover@io.com>
 
 chansen: Christian Hansen
 
+Chase Venters C<chase.venters@gmail.com>
+
 chicks: Christopher Hicks
 
 Chisel Wright C<pause@herlpacker.co.uk>