X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=cef7ac7be4989384fcde50e97e808fce8304230d;hp=bfbf763df1f7a97238ab097047447421ebb9a552;hb=64d969197ee915ca489db95a9ceac4b91a9078ea;hpb=6dae3eef2b4e3c38a657201e77672aef830a87f6

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index bfbf763..cef7ac7 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -1,8 +1,14 @@
 package Catalyst;
 
+# we don't need really need this, but if we load it before MRO::Compat gets
+# loaded (via Moose and Class::MOP), we can avoid some nasty warnings
+use Class::C3;
+
 use Moose;
+use Class::MOP::Object ();
 extends 'Catalyst::Component';
 use bytes;
+use Scope::Upper ();
 use Catalyst::Exception;
 use Catalyst::Log;
 use Catalyst::Request;
@@ -29,7 +35,7 @@ use Carp qw/croak carp/;
 
 BEGIN { require 5.008001; }
 
-has stack => (is => 'rw', default => sub { [] });
+has stack => (is => 'ro', default => sub { [] });
 has stash => (is => 'rw', default => sub { {} });
 has state => (is => 'rw', default => 0);
 has stats => (is => 'rw');
@@ -76,7 +82,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.7099_03';
+our $VERSION = '5.8000_04';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -257,7 +263,9 @@ MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 
 =head2 -Log
 
-Specifies log level.
+    use Catalyst '-Log=warn,fatal,error';
+ 
+Specifies a comma-delimited list of log levels.
 
 =head2 -Stats
 
@@ -346,13 +354,33 @@ When called with no arguments it escapes the processing chain entirely.
 
 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 
+=head2 $c->visit( $action [, \@arguments ] )
+
+=head2 $c->visit( $class, $method, [, \@arguments ] )
+
+Almost the same as C<forward>, but does a full dispatch, instead of just
+calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
+C<auto> and the method you go to are called, just like a new request.
+
+C<$c-E<gt>stash> is kept unchanged.
+
+In effect, C<visit> allows you to "wrap" another action, just as it
+would have been called by dispatching from a URL, while the analogous
+C<go> allows you to transfer control to another action as if it had
+been reached directly from a URL.
+
+=cut
+
+sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
+
 =head2 $c->go( $action [, \@arguments ] )
 
 =head2 $c->go( $class, $method, [, \@arguments ] )
 
-Almost the same as C<detach>, but does a full dispatch, instead of just
-calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
-C<auto> and the method you go to is called, just like a new request.
+Almost the same as C<detach>, but does a full dispatch like C<visit>,
+instead of just calling the new C<$action> /
+C<$class-E<gt>$method>. This means that C<begin>, C<auto> and the
+method you visit are called, just like a new request.
 
 C<$c-E<gt>stash> is kept unchanged.
 
@@ -506,7 +534,7 @@ sub _comp_names {
 sub _filter_component {
     my ( $c, $comp, @args ) = @_;
 
-    if ( Scalar::Util::blessed($c) && eval { $comp->can('ACCEPT_CONTEXT'); } ) {
+    if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
         return $comp->ACCEPT_CONTEXT( $c, @args );
     }
     
@@ -945,8 +973,8 @@ EOF
         my $engine     = $class->engine;
         my $home       = $class->config->{home};
 
-        $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
-        $class->log->debug(qq/Loaded engine "$engine"/);
+        $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
+        $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
 
         $home
           ? ( -d $home )
@@ -955,7 +983,7 @@ EOF
           : $class->log->debug(q/Couldn't find home/);
     }
 
-    # Call plugins setup
+    # Call plugins setup, this is stupid and evil.
     {
         no warnings qw/redefine/;
         local *setup = sub { };
@@ -990,26 +1018,44 @@ EOF
     }
     $class->log->_flush() if $class->log->can('_flush');
 
+    # Make sure that the application class becomes immutable at this point, 
+    # which ensures that it gets an inlined constructor. This means that it 
+    # works even if the user has added a plugin which contains a new method.
+    # Note however that we have to do the work on scope end, so that method
+    # modifiers work correctly in MyApp (as you have to call setup _before_ 
+    # applying modifiers).
+    Scope::Upper::reap(sub {
+        my $meta = $class->Moose::Object::meta();
+        $meta->make_immutable unless $meta->is_immutable;
+    }, 1);
+
     $class->setup_finished(1);
 }
 
+=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
+
 =head2 $c->uri_for( $path, @args?, \%query_values? )
 
-Merges path with C<< $c->request->base >> for absolute URIs and with
-C<< $c->namespace >> for relative URIs, then returns a normalized L<URI>
-object. If any args are passed, they are added at the end of the path.
-If the last argument to C<uri_for> is a hash reference, it is assumed to
-contain GET parameter key/value pairs, which will be appended to the URI
-in standard fashion.
+=over
+
+=item $action
 
-Note that uri_for is destructive to the passed hashref.  Subsequent calls
-with the same hashref may have unintended results.
+A Catalyst::Action object representing the Catalyst action you want to
+create a URI for. To get one for an action in the current controller,
+use C<< $c->action('someactionname') >>. To get one from different
+controller, fetch the controller using C<< $c->controller() >>, then
+call C<action_for> on it.
 
-Instead of C<$path>, you can also optionally pass a C<$action> object
-which will be resolved to a path using
-C<< $c->dispatcher->uri_for_action >>; if the first element of
-C<@args> is an arrayref it is treated as a list of captures to be passed
-to C<uri_for_action>.
+You can maintain the arguments captured by an action (e.g.: Regex, Chained)
+using C<< $c->req->captures >>. 
+
+  # For the current action
+  $c->uri_for($c->action, $c->req->captures);
+  
+  # For the Foo action in the Bar controller
+  $c->uri_for($c->controller->('Bar')->action_for('Foo'), $c->req->captures);
+
+=back
 
 =cut
 
@@ -1046,7 +1092,7 @@ sub uri_for {
     # join args with '/', or a blank string
     my $args = join('/', grep { defined($_) } @args);
     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
-    $args =~ s!^/!!;
+    $args =~ s!^/+!!;
     my $base = $c->req->base;
     my $class = ref($base);
     $base =~ s{(?<!/)$}{/};
@@ -1206,7 +1252,7 @@ sub welcome_message {
                          <a href="http://dev.catalyst.perl.org">Wiki</a>
                      </li>
                      <li>
-                         <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
+                         <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
                      </li>
                      <li>
                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
@@ -1505,8 +1551,7 @@ sub finalize_headers {
         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
         $response->header( Location => $location );
 
-        #Moose TODO: we should probably be using a predicate method here ?
-        if ( !$response->body ) {
+        if ( !$response->has_body ) {
             # Add a default body if none is already present
             $response->body(
                 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
@@ -1702,9 +1747,7 @@ Prepares message body.
 sub prepare_body {
     my $c = shift;
 
-    #Moose TODO: what is  _body ??
-    # Do we run for the first time?
-    return if defined $c->request->{_body};
+    return if $c->request->_has_body;
 
     # Initialize on-demand data
     $c->engine->prepare_body( $c, @_ );
@@ -2051,9 +2094,10 @@ sub setup_engine {
     }
 
     if ( $ENV{MOD_PERL} ) {
-
+        my $meta = $class->Class::MOP::Object::meta();
+        
         # create the apache method
-        $class->meta->add_method('apache' => sub { shift->engine->apache });
+        $meta->add_method('apache' => sub { shift->engine->apache });
 
         my ( $software, $version ) =
           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
@@ -2111,9 +2155,6 @@ sub setup_engine {
     }
 
     Class::MOP::load_class($engine);
-    #unless (Class::Inspector->loaded($engine)) {
-    #    require Class::Inspector->filename($engine);
-    #}
 
     # check for old engines that are no longer compatible
     my $old_engine;
@@ -2175,20 +2216,35 @@ sub setup_home {
 
 =head2 $c->setup_log
 
-Sets up log.
+Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
+passing it to C<log()>. Pass in a comma-delimited list of levels to set the
+log to.
+ 
+This method also installs a C<debug> method that returns a true value into the
+catalyst subclass if the "debug" level is passed in the comma-delimited list,
+or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
+
+Note that if the log has already been setup, by either a previous call to
+C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
+that this method won't actually set up the log object.
 
 =cut
 
 sub setup_log {
-    my ( $class, $debug ) = @_;
+    my ( $class, $levels ) = @_;
 
+    $levels ||= '';
+    $levels =~ s/^\s+//;
+    $levels =~ s/\s+$//;
+    my %levels = map { $_ => 1 } split /\s*,\s*/, $levels || '';
+    
     unless ( $class->log ) {
-        $class->log( Catalyst::Log->new );
+        $class->log( Catalyst::Log->new(keys %levels) );
     }
 
     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
-    if ( defined($env_debug) ? $env_debug : $debug ) {
-        $class->meta->add_method('debug' => sub { 1 });
+    if ( defined($env_debug) or $levels{debug} ) {
+        $class->Class::MOP::Object::meta()->add_method('debug' => sub { 1 });
         $class->log->debug('Debug messages enabled');
     }
 }
@@ -2212,7 +2268,7 @@ sub setup_stats {
 
     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
-        $class->meta->add_method('use_stats' => sub { 1 });
+        $class->Class::MOP::Object::meta()->add_method('use_stats' => sub { 1 });
         $class->log->debug('Statistics enabled');
     }
 }
@@ -2255,9 +2311,9 @@ the plugin name does not begin with C<Catalyst::Plugin::>.
         $proto->_plugins->{$plugin} = 1;
         unless ($instant) {
             no strict 'refs';
-            if( $class->can('meta') ){
-              my @superclasses = ($plugin, $class->meta->superclasses );
-              $class->meta->superclasses(@superclasses);
+            if ( my $meta = $class->Class::MOP::Object::meta() ) {
+              my @superclasses = ($plugin, $meta->superclasses );
+              $meta->superclasses(@superclasses);
             } else {
               unshift @{"$class\::ISA"}, $plugin;
             }
@@ -2406,8 +2462,8 @@ IRC:
 
 Mailing Lists:
 
-    http://lists.rawmode.org/mailman/listinfo/catalyst
-    http://lists.rawmode.org/mailman/listinfo/catalyst-dev
+    http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
+    http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
 
 Web:
 
@@ -2457,10 +2513,14 @@ audreyt: Audrey Tang
 
 bricas: Brian Cassidy <bricas@cpan.org>
 
+Caelum: Rafael Kitover <rkitover@io.com>
+
 chansen: Christian Hansen
 
 chicks: Christopher Hicks
 
+David E. Wheeler
+
 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
 
 Drew Taylor