add support for args to uri_for.
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
index 86886b0..3df8da8 100644 (file)
@@ -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;
@@ -43,6 +45,8 @@ __PACKAGE__->mk_classdata($_)
 
 our $VERSION = '5.49_01';
 
+sub version { return $Catalyst::VERSION }
+
 sub import {
     my ( $class, @arguments ) = @_;
 
@@ -167,6 +171,10 @@ Specify log level.
 
 =over 4
 
+=item $c->action
+
+Accessor for the current action
+
 =item $c->comp($name)
 
 =item $c->component($name)
@@ -251,6 +259,10 @@ 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->setup
 
 Setup.
@@ -379,26 +391,30 @@ 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;
     $match = '' if $path =~ /^\//;
     $path =~ s/^\///;
-    return URI->new_abs( URI->new_abs( $path, "$basepath$match" ), $base )
+    # 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;
 }
 
@@ -531,9 +547,10 @@ 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 $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>
@@ -616,41 +633,26 @@ sub welcome_message {
                  <img src="$logo"/>
                  </p>
                  <p>Welcome to the wonderful world of Catalyst.
-                    This MVC framework will make web development
-                    something you had never expected it to be:
-                    Fun, rewarding and quick.</p>
+                    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.pod">Catalyst::Manual</a>
-perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a></code></pre>
-                 <p>If you would like some background information on the
-                    MVC-pattern, these links might be of help to you.</p>
-                 <ul>
-                     <li>
-                         <a href="http://dev.catalyst.perl.org/wiki/Models">
-                             Introduction to Models
-                         </a>
-                     </li>
-                     <li>
-                         <a href="http://dev.catalyst.perl.org/wiki/Views">
-                             Introduction to Views
-                         </a>
-                     </li>
-                     <li>
-                         <a href="http://dev.catalyst.perl.org/wiki/Controllers">
-                             Introduction to Controllers
-                         </a>
-                     </li>
-                 </ul>
+                 <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 controllers, models and views, they 
-                    can save you a lot of work. Also, be sure to check out the vast 
-                    and growing collection of plugins for Catalyst on CPAN, you are 
-                    likely to find what you need there.
+                    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>
@@ -754,14 +756,15 @@ sub execute {
     }
     $c->{depth}++;
     eval {
-        if ( $c->debug )
-        {
+        if ( $c->debug ) {
             my ( $elapsed, @state ) =
               $c->benchmark( $code, $class, $c, @{ $c->req->args } );
             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}--;
 
@@ -1680,7 +1683,7 @@ Sebastian Riedel, C<sri@oook.de>
 
 =head1 LICENSE
 
-This library is free software . You can redistribute it and/or modify it under
+This library is free software, you can redistribute it and/or modify it under
 the same terms as Perl itself.
 
 =cut