add support for args to uri_for.

[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 89b7f9f..3df8da8 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -45,6 +45,8 @@ __PACKAGE__->mk_classdata($_)
 
 our $VERSION = '5.49_01';
 
+sub version { return $Catalyst::VERSION }
+
 sub import {
     my ( $class, @arguments ) = @_;
 
@@ -389,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;
 }
 
@@ -750,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}--;
 
@@ -1676,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