X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=71ce8cce0070baa35e90db9a4b62015571c4170b;hp=f6d1408d9e7395ecd359efbf7fd5168693be772c;hb=c4770d9b88bb84708a170f0d21484b6ad5123f3f;hpb=bc2beef5b251464257ade572b65d58698ae67a01

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index f6d1408..71ce8cc 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -17,7 +17,9 @@ use Time::HiRes qw/gettimeofday tv_interval/;
 use URI;
 use Scalar::Util qw/weaken/;
 
-__PACKAGE__->mk_accessors(qw/counter depth request response state/);
+__PACKAGE__->mk_accessors(
+    qw/counter depth request response state action namespace/
+);
 
 # Laziness++
 *comp = \&component;
@@ -36,12 +38,12 @@ our $DETACH    = "catalyst_detach\n";
 require Module::Pluggable::Fast;
 
 # Helper script generation
-our $CATALYST_SCRIPT_GEN = 6;
+our $CATALYST_SCRIPT_GEN = 10;
 
 __PACKAGE__->mk_classdata($_)
   for qw/components arguments dispatcher engine log/;
 
-our $VERSION = '5.49_01';
+our $VERSION = '5.49_02';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -167,6 +169,10 @@ Specify log level.
 
 =over 4
 
+=item $c->action
+
+Accessor for the current action
+
 =item $c->comp($name)
 
 =item $c->component($name)
@@ -251,6 +257,27 @@ from the function.
 
 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
 
+=item $c->namespace
+
+Accessor to the namespace of the current action
+
+=item $c->path_to(@path)
+
+Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
+
+For example:
+
+    $c->path_to( 'db', 'sqlite.db' );
+
+=cut
+
+sub path_to {
+    my ( $c, @path ) = @_;
+    my $path = dir( $c->config->{home}, @path );
+    if ( -d $path ) { return $path }
+    else { return file( $c->config->{home}, @path ) }
+}
+
 =item $c->setup
 
 Setup.
@@ -379,27 +406,34 @@ sub setup {
     $class->log->_flush() if $class->log->can('_flush');
 }
 
-=item $c->uri_for($path)
+=item $c->uri_for($path,[@args])
 
 Merges path with $c->request->base for absolute uri's and with
 $c->request->match for relative uri's, then returns a normalized
-L<URI> object.
+L<URI> object. If any args are passed, they are added at the end
+of the path.
 
 =cut
 
 sub uri_for {
-    my ( $c, $path ) = @_;
+    my ( $c, $path, @args ) = @_;
     my $base     = $c->request->base->clone;
     my $basepath = $base->path;
     $basepath =~ s/\/$//;
     $basepath .= '/';
     my $match = $c->request->match;
+
+    # massage match, empty if absolute path
     $match =~ s/^\///;
     $match .= '/' if $match;
+    $path ||= '';
     $match = '' if $path =~ /^\//;
     $path =~ s/^\///;
-    return URI->new_abs( URI->new_abs( $path, "$basepath$match" ), $base )
-      ->canonical;
+
+    # join args with '/', or a blank string
+    my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
+    return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
+        $base )->canonical;
 }
 
 =item $c->error
@@ -416,13 +450,20 @@ Add a new error.
 
     $c->error('Something bad happened');
 
+Clean errors.
+
+    $c->error(0);
+
 =cut
 
 sub error {
     my $c = shift;
-    my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
-    push @{ $c->{error} }, @$error;
-    return $c->{error};
+    if ( $_[0] ) {
+        my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
+        push @{ $c->{error} }, @$error;
+    }
+    elsif ( defined $_[0] ) { $c->{error} = undef }
+    return $c->{error} || [];
 }
 
 =item $c->engine
@@ -500,9 +541,17 @@ Contains the return value of the last executed action.
 
 Returns a hashref containing all your data.
 
-    $c->stash->{foo} ||= 'yada';
     print $c->stash->{foo};
 
+Keys may be set in the stash by assigning to the hash reference, or by passing
+either a single hash reference or a list of key/value pairs as arguments.
+
+For example:
+
+    $c->stash->{foo} ||= 'yada';
+    $c->stash( { moose => 'majestic', qux => 0 } );
+    $c->stash( bar => 1, gorch => 2 );
+
 =cut
 
 sub stash {
@@ -516,6 +565,146 @@ sub stash {
     return $c->{stash};
 }
 
+=item $c->welcome_message
+
+Returns the Catalyst welcome HTML page.
+
+=cut
+
+sub welcome_message {
+    my $c      = shift;
+    my $name   = $c->config->{name};
+    my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
+    my $prefix = Catalyst::Utils::appprefix( ref $c );
+    return <<"EOF";
+<html>
+    <head>
+        <title>$name on Catalyst $VERSION</title>
+        <style type="text/css">
+            body {
+                text-align: center;
+                padding-left: 50%;
+                color: #000;
+                background-color: #eee;
+            }
+            div#content {
+                width: 640px;
+                margin-left: -320px;
+                margin-top: 10px;
+                margin-bottom: 10px;
+                text-align: left;
+                background-color: #ccc;
+                border: 1px solid #aaa;
+                -moz-border-radius: 10px;
+            }
+            p, h1, h2 {
+                margin-left: 20px;
+                margin-right: 20px;
+                font-family: verdana, tahoma, sans-serif;
+            }
+            a {
+                font-family: verdana, tahoma, sans-serif;
+            }
+            :link, :visited {
+                    text-decoration: none;
+                    color: #b00;
+                    border-bottom: 1px dotted #bbb;
+            }
+            :link:hover, :visited:hover {
+                    color: #555;
+            }
+            div#topbar {
+                margin: 0px;
+            }
+            pre {
+                margin: 10px;
+                padding: 8px;
+            }
+            div#answers {
+                padding: 8px;
+                margin: 10px;
+                background-color: #fff;
+                border: 1px solid #aaa;
+                -moz-border-radius: 10px;
+            }
+            h1 {
+                font-size: 0.9em;
+                font-weight: normal;
+                text-align: center;
+            }
+            h2 {
+                font-size: 1.0em;
+            }
+            p {
+                font-size: 0.9em;
+            }
+            p img {
+                float: right;
+                margin-left: 10px;
+            }
+            b#appname {
+                font-size: 1.6em;
+            }
+        </style>
+    </head>
+    <body>
+        <div id="content">
+            <div id="topbar">
+                <h1><b id="appname">$name</b> on <a href="http://catalyst.perl.org">Catalyst</a>
+                    $VERSION</h1>
+             </div>
+             <div id="answers">
+                 <p>
+                 <img src="$logo"/>
+                 </p>
+                 <p>Welcome to the wonderful world of Catalyst.
+                    This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
+                    framework will make web development something you had
+                    never expected it to be: Fun, rewarding and quick.</p>
+                 <h2>What to do now?</h2>
+                 <p>That really depends  on what <b>you</b> want to do.
+                    We do, however, provide you with a few starting points.</p>
+                 <p>If you want to jump right into web development with Catalyst
+                    you might want to check out the documentation.</p>
+                 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
+perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
+                 <h2>What to do next?</h2>
+                 <p>Next it's time to write an actual application. Use the
+                    helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
+                    <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
+                    <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
+                    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&mode=all">plugins for Catalyst on CPAN</a>,
+                    you are likely to find what you need there.
+                    </p>
+
+                 <h2>Need help?</h2>
+                 <p>Catalyst has a very active community. Here are the main places to
+                    get in touch with us.</p>
+                 <ul>
+                     <li>
+                         <a href="http://dev.catalyst.perl.org">Wiki</a>
+                     </li>
+                     <li>
+                         <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
+                     </li>
+                     <li>
+                         <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
+                     </li>
+                 </ul>
+                 <h2>In conclusion</h2>
+                 <p>The Catalyst team hopes you will enjoy using Catalyst as much 
+                    as we enjoyed making it. Please contact us if you have ideas
+                    for improvement or other feedback.</p>
+             </div>
+         </div>
+    </body>
+</html>
+EOF
+}
+
 =back
 
 =head1 INTERNAL METHODS
@@ -561,6 +750,18 @@ Dispatch request to actions.
 
 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
 
+=item dump_these
+
+Returns a list of 2-element array references (name, structure) pairs that will
+be dumped on the error page in debug mode.
+
+=cut
+
+sub dump_these {
+    my $c = shift;
+    [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
+}
+
 =item $c->execute($class, $coderef)
 
 Execute a coderef in given class and catch exceptions.
@@ -596,10 +797,16 @@ sub execute {
         {
             my ( $elapsed, @state ) =
               $c->benchmark( $code, $class, $c, @{ $c->req->args } );
-            push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
+            unless ( ( $code->name =~ /^_.*/ )
+                && ( !$c->config->{show_internal_actions} ) )
+            {
+                push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
+            }
             $c->state(@state);
         }
-        else { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) }
+        else {
+            $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
+        }
     };
     $c->{depth}--;
 
@@ -729,7 +936,7 @@ Finalize uploads.  Cleans up any temporary files.
 
 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
 
-=item $c->get_action( $action, $namespace, $inherit )
+=item $c->get_action( $action, $namespace )
 
 Get an action in a given namespace.
 
@@ -737,6 +944,14 @@ Get an action in a given namespace.
 
 sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
 
+=item $c->get_actions( $action, $namespace )
+
+Get all actions of a given name in a namespace and all base namespaces.
+
+=cut
+
+sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
+
 =item handle_request( $class, @arguments )
 
 Handles the request.
@@ -1271,6 +1486,38 @@ qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
         );
     }
 
+    # check for old engines that are no longer compatible
+    my $old_engine;
+    if ( $engine->isa('Catalyst::Engine::Apache')
+        && !Catalyst::Engine::Apache->VERSION )
+    {
+        $old_engine = 1;
+    }
+
+    elsif ( $engine->isa('Catalyst::Engine::Server::Base')
+        && Catalyst::Engine::Server->VERSION le '0.02' )
+    {
+        $old_engine = 1;
+    }
+
+    elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
+        && $engine->VERSION eq '0.01' )
+    {
+        $old_engine = 1;
+    }
+
+    elsif ($engine->isa('Catalyst::Engine::Zeus')
+        && $engine->VERSION eq '0.01' )
+    {
+        $old_engine = 1;
+    }
+
+    if ($old_engine) {
+        Catalyst::Exception->throw( message =>
+              qq/Engine "$engine" is not supported by this version of Catalyst/
+        );
+    }
+
     # engine instance
     $class->engine( $engine->new );
 }
@@ -1361,8 +1608,27 @@ sub write {
     return $c->engine->write( $c, @_ );
 }
 
+=item version
+
+Returns the Catalyst version number. mostly useful for powered by messages
+in template systems.
+
+=cut
+
+sub version { return $Catalyst::VERSION }
+
 =back
 
+=head1 INTERNAL ACTIONS
+
+Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
+C<_ACTION> and C<_END>, these are by default not shown in the private
+action table.
+
+But you can deactivate this with a config parameter.
+
+    MyApp->config->{show_internal_actions} = 1;
+
 =head1 CASE SENSITIVITY
 
 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
@@ -1462,6 +1728,10 @@ Andy Grundman
 
 Andy Wardley
 
+Andreas Marienborg
+
+Andrew Bramble
+
 Andrew Ford
 
 Andrew Ruthven
@@ -1502,6 +1772,8 @@ Matt S Trout
 
 Robert Sedlacek
 
+Sam Vilain
+
 Tatsuhiko Miyagawa
 
 Ulf Edvinsson
@@ -1514,8 +1786,8 @@ Sebastian Riedel, C<sri@oook.de>
 
 =head1 LICENSE
 
-This library is free software . You can redistribute it and/or modify it under
-the same terms as perl itself.
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
 
 =cut