pass replace_constructor when making app immutable to force installation
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
index 8805134..a628d53 100644 (file)
@@ -1,7 +1,8 @@
 package Catalyst;
 
 use Moose;
-extends 'Catalyst::Component';
+extends 'Catalyst::Component', 'Class::Accessor::Fast';
+use Moose::Util qw/find_meta/;
 use bytes;
 use Scope::Upper ();
 use Catalyst::Exception;
@@ -43,11 +44,9 @@ sub depth { scalar @{ shift->stack || [] }; }
 sub comp { shift->component(@_) }
 
 sub req {
-    # carp "the use of req() is deprecated in favour of request()";
     my $self = shift; return $self->request(@_);
 }
 sub res {
-    # carp "the use of res() is deprecated in favour of response()";
     my $self = shift; return $self->response(@_);
 }
 
@@ -76,7 +75,14 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.8000_06';
+our $VERSION = '5.80002';
+
+{
+    my $dev_version = $VERSION =~ /_\d{2}$/;
+    *_IS_DEVELOPMENT_VERSION = sub () { $dev_version };
+}
+
+$VERSION = eval $VERSION;
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -89,7 +95,7 @@ sub import {
     return if $caller eq 'main';
 
     # Kill Adopt::NEXT warnings if we're a non-RC version
-    if ($VERSION !~ /_\d{2}$/) {
+    unless (_IS_DEVELOPMENT_VERSION()) {
         Class::C3::Adopt::NEXT->unimport(qr/^Catalyst::/);
     }
 
@@ -354,9 +360,9 @@ 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( $action [, \@captures, \@arguments ] )
 
-=head2 $c->visit( $class, $method, [, \@arguments ] )
+=head2 $c->visit( $class, $method, [, \@captures, \@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>,
@@ -380,9 +386,9 @@ been reached directly from a URL.
 
 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
 
-=head2 $c->go( $action [, \@arguments ] )
+=head2 $c->go( $action [, \@captures, \@arguments ] )
 
-=head2 $c->go( $class, $method, [, \@arguments ] )
+=head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
 
 Almost the same as C<detach>, but does a full dispatch like C<visit>,
 instead of just calling the new C<$action> /
@@ -491,6 +497,7 @@ sub _comp_search_prefixes {
     my ( $c, $name, @prefixes ) = @_;
     my $appclass = ref $c || $c;
     my $filter   = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
+    $filter = qr/$filter/; # Compile regex now rather than once per loop
 
     # map the original component name to the sub part that we will search against
     my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
@@ -518,7 +525,9 @@ sub _comp_search_prefixes {
 
     # don't warn if we didn't find any results, it just might not exist
     if( @result ) {
-        my $msg = "Used regexp fallback for \$c->model('${name}'), which found '" .
+        # Disgusting hack to work out correct method name
+        my $warn_for = lc $prefixes[0];
+        my $msg = "Used regexp fallback for \$c->{$warn_for}('${name}'), which found '" .
            (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
            "component resolution is unreliable and unsafe.";
         my $short = $result[0];
@@ -531,9 +540,9 @@ sub _comp_search_prefixes {
            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
               "component's config";
         } else {
-           $msg .= " You probably meant \$c->model('$short') instead of \$c->model{'${name}'}, " .
+           $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}({'${name}'}), " .
               "but if you really wanted to search, pass in a regexp as the argument " .
-              "like so: \$c->model(qr/${name}/)";
+              "like so: \$c->${warn_for}(qr/${name}/)";
         }
         $c->log->warn( "${msg}$shortmess" );
     }
@@ -797,12 +806,34 @@ Returns or takes a hashref containing the application's configuration.
     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
 
 You can also use a C<YAML>, C<XML> or C<Config::General> config file
-like myapp.yml in your applications home directory. See
+like myapp.conf in your applications home directory. See
 L<Catalyst::Plugin::ConfigLoader>.
 
-    ---
-    db: dsn:SQLite:foo.db
+=head3 Cascading configuration.
 
+The config method is present on all Catalyst components, and configuration
+will be merged when an application is started. Configuration loaded with
+L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
+followed by configuration in your top level C<MyApp> class. These two 
+configurations are merged, and then configuration data whos hash key matches a
+component name is merged with configuration for that component.
+
+The configuration for a component is then passed to the C<new> method when a
+component is constructed.
+
+For example:
+
+    MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
+    MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
+    
+will mean that C<MyApp::Model::Foo> receives the following data when 
+constructed:
+
+    MyApp::Model::Foo->new({
+        bar => 'baz',
+        quux => 'frob',
+        overrides => 'me',
+    });
 
 =cut
 
@@ -836,10 +867,21 @@ L<Catalyst::Log>.
 
 =head2 $c->debug
 
-Overload to enable debug messages (same as -Debug option).
+Returns 1 if debug mode is enabled, 0 otherwise.
 
-Note that this is a static method, not an accessor and should be overloaded
-by declaring "sub debug { 1 }" in your MyApp.pm, not by calling $c->debug(1).
+You can enable debug mode in several ways:
+
+=over
+
+=item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
+
+=item The -Debug option in your MyApp.pm
+
+=item By declaring "sub debug { 1 }" in your MyApp.pm.
+
+=back
+
+Calling $c->debug(1) has no effect.
 
 =cut
 
@@ -882,9 +924,9 @@ loads and instantiates the given class.
     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 
     $c->prototype->define_javascript_functions;
-    
+
 B<Note:> This method of adding plugins is deprecated. The ability
-to add plugins like this B<will be removed> in a Catalyst 5.9.
+to add plugins like this B<will be removed> in a Catalyst 5.81.
 Please do not use this functionality in new code.
 
 =cut
@@ -892,9 +934,9 @@ Please do not use this functionality in new code.
 sub plugin {
     my ( $class, $name, $plugin, @args ) = @_;
 
-    # See block comment in t/unit_core_plugin.t    
-    $class->log->debug(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.9/);
-    
+    # See block comment in t/unit_core_plugin.t
+    $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
+
     $class->_register_plugin( $plugin, 1 );
 
     eval { $plugin->import };
@@ -1013,10 +1055,11 @@ EOF
     }
 
     # Call plugins setup, this is stupid and evil.
+    # Also screws C3 badly on 5.10, hack to avoid.
     {
         no warnings qw/redefine/;
         local *setup = sub { };
-        $class->setup;
+        $class->setup unless $Catalyst::__AM_RESTARTING;
     }
 
     # Initialize our data structure
@@ -1056,7 +1099,7 @@ EOF
     # applying modifiers).
     Scope::Upper::reap(sub {
         my $meta = Class::MOP::get_metaclass_by_name($class);
-        $meta->make_immutable unless $meta->is_immutable;
+        $meta->make_immutable(replace_constructor => 1) unless $meta->is_immutable;
     }, Scope::Upper::SCOPE(1));
 
     $class->setup_finalize;
@@ -1066,7 +1109,7 @@ EOF
 =head2 $app->setup_finalize
 
 A hook to attach modifiers to.
-Using C< after setup => sub{}; > doesn't work, because of quirky things done for plugin setup.
+Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup.
 Also better than C< setup_finished(); >, as that is a getter method.
 
     sub setup_finalize {
@@ -1121,8 +1164,13 @@ sub uri_for {
         my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
                          ? shift(@args)
                          : [] );
-        $path = $c->dispatcher->uri_for_action($path, $captures);
-        return undef unless defined($path);
+        my $action = $path;
+        $path = $c->dispatcher->uri_for_action($action, $captures);
+        if (not defined $path) {
+            $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
+                if $c->debug;
+            return undef;
+        }
         $path = '/' if $path eq '';
     }
 
@@ -1176,6 +1224,38 @@ sub uri_for {
     $res;
 }
 
+=head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
+
+=head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
+
+=over
+
+=item $path
+
+A private path to the Catalyst action you want to create a URI for.
+
+This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
+>> and passing the resulting C<$action> and the remaining arguments to C<<
+$c->uri_for >>.
+
+You can also pass in a Catalyst::Action object, in which case it is passed to
+C<< $c->uri_for >>.
+
+=back
+
+=cut
+
+sub uri_for_action {
+    my ( $c, $path, @args ) = @_;
+    my $action = blessed($path) 
+      ? $path 
+      : $c->dispatcher->get_action_by_path($path);
+    unless (defined $action) {
+      croak "Can't find action for path '$path'";
+    }
+    return $c->uri_for( $action, @args );
+}
+
 =head2 $c->welcome_message
 
 Returns the Catalyst welcome HTML page.
@@ -1295,7 +1375,7 @@ sub welcome_message {
                     they can save you a lot of work.</p>
                     <pre><code>script/${prefix}_create.pl -help</code></pre>
                     <p>Also, be sure to check out the vast and growing
-                    collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&amp;mode=all">plugins for Catalyst on CPAN</a>;
+                    collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
                     you are likely to find what you need there.
                     </p>
 
@@ -1402,6 +1482,7 @@ sub execute {
 
     push( @{ $c->stack }, $code );
     
+    no warnings 'recursion';
     eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
 
     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
@@ -2051,7 +2132,7 @@ sub setup_components {
     my $deprecated_component_names = grep { /::[CMV]::/ } @comps;
     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
-    );
+    ) if $deprecated_component_names;
 
     for my $component ( @comps ) {
 
@@ -2082,6 +2163,14 @@ sub setup_components {
 
 =cut
 
+sub _controller_init_base_classes {
+    my ($class, $component) = @_;
+    foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) {
+        Moose->init_meta( for_class => $class )
+            unless find_meta($class);
+    }
+}
+
 sub setup_component {
     my( $class, $component ) = @_;
 
@@ -2089,6 +2178,14 @@ sub setup_component {
         return $component;
     }
 
+    # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
+    #         nearest to Catalyst::Controller first, no matter what order stuff happens
+    #         to be loaded. There are TODO tests in Moose for this, see
+    #         f2391d17574eff81d911b97be15ea51080500003
+    if ($component->isa('Catalyst::Controller')) {
+        $class->_controller_init_base_classes($component);
+    }
+    
     my $suffix = Catalyst::Utils::class2classsuffix( $component );
     my $config = $class->config->{ $suffix } || {};
 
@@ -2101,11 +2198,16 @@ sub setup_component {
         );
     }
 
-    Catalyst::Exception->throw(
-        message =>
-        qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
-    ) unless blessed($instance);
-
+    unless (blessed $instance) {
+        my $metaclass = Moose::Util::find_meta($component);
+        my $method_meta = $metaclass->find_method_by_name('COMPONENT');
+        my $component_method_from = $method_meta->associated_metaclass->name;
+        my $value = defined($instance) ? $instance : 'undef';
+        Catalyst::Exception->throw(
+            message =>
+            qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
+        );
+    }
     return $instance;
 }