major refactor, all tests passing

[catagits/Catalyst-Plugin-SubRequest.git] / lib / Catalyst / Plugin / SubRequest.pm

diff --git a/lib/Catalyst/Plugin/SubRequest.pm b/lib/Catalyst/Plugin/SubRequest.pm
index 0494b27..5725374 100644 (file)
--- a/lib/Catalyst/Plugin/SubRequest.pm
+++ b/lib/Catalyst/Plugin/SubRequest.pm
@@ -1,9 +1,9 @@
 package Catalyst::Plugin::SubRequest;
 
 use strict;
-use Time::HiRes qw/tv_interval/;
+use warnings;
 
-our $VERSION = '0.14';
+our $VERSION = '0.17';
 
 =head1 NAME
 
@@ -13,103 +13,122 @@ Catalyst::Plugin::SubRequest - Make subrequests to actions in Catalyst
 
     use Catalyst 'SubRequest';
 
-    $c->subreq('/test/foo/bar', { template => 'magic.tt' });
+    my $res_body = $c->subreq('/test/foo/bar', { template => 'magic.tt' });
 
-    $c->subreq(        {       path            => '/test/foo/bar',
-                       body            => $body        },
-               {       template        => 'magic.tt'           });
+    my $res_body = $c->subreq( {
+       path            => '/test/foo/bar',
+       body            => $body
+    }, {
+       template        => 'magic.tt'
+    });
+
+    # Get the full response object
+    my $res = $c->subreq_res('/test/foo/bar', {
+        template => 'mailz.tt'
+    }, {
+        param1   => 23
+    });
+    $c->log->warn( $res->content_type );
 
 =head1 DESCRIPTION
 
 Make subrequests to actions in Catalyst. Uses the  catalyst
 dispatcher, so it will work like an external url call.
+Methods are provided both to get the body of the response and the full
+response (L<Catalyst::Response>) object.
 
 =head1 METHODS
 
-=over 4 
+=over 4
 
 =item subreq [path as string or hash ref], [stash as hash ref], [parameters as hash ref]
 
+=item subrequest
+
 =item sub_request
 
 Takes a full path to a path you'd like to dispatch to.
-If the path is passed as a hash ref then it can include body, action, match and path.
-Any additional parameters are put into the stash.
 
-=back 
+If the path is passed as a hash ref then it can include body, action,
+match and path.
 
-=cut
+An optional second argument as hashref can contain data to put into the
+stash of the subrequest.
 
-*subreq = \&sub_request;
+An optional third argument as hashref can contain data to pass as
+parameters to the subrequest.
 
-sub sub_request {
-    my ( $c, $path, $stash, $params ) = @_;
+Returns the body of the response.
 
-    $path =~ s#^/##;
+=item subreq_res [path as string or hash ref], [stash as hash ref], [parameters as hash ref]
 
-    $params ||= {};
+=item subrequest_response
 
-    my %request_mods = (
-        body => undef,
-        action => undef,
-        match => undef,
-        parameters => $params,
-    );
+=item sub_request_response
 
-    if (ref $path eq 'HASH') {
-        @request_mods{keys %$path} = values %$path;
-    } else {
-        $request_mods{path} = $path;
-    }
+Like C<sub_request()>, but returns a full L<Catalyst::Response> object.
 
-    my $fake_engine = bless(
-        {
-            orig_request => $c->req,
-            request_mods => \%request_mods,
-        },
-        'Catalyst::Plugin::SubRequest::Internal::FakeEngine'
-    );
+=back
 
-    my $class = ref($c);
+=cut
 
-    no strict 'refs';
-    no warnings 'redefine';
+*subreq = \&sub_request;
+*subrequest = \&sub_request;
+*subreq_res = \&sub_request_response;
+*subrequest_response = \&sub_request_response;
 
-    local *{"${class}::engine"} = sub { $fake_engine };
+sub sub_request {
+    return shift->sub_request_response( @_ )->body ;
+}
 
-    my $inner_ctx = $class->prepare;
+sub sub_request_response {
+    my ( $c, $path, $stash, $params ) = @_;
+    $stash ||= {};
+    my $env = $c->request->env;
+    local $env->{PATH_INFO} = $path;
+    local $env->{REQUEST_URI} = $env->{SCRIPT_NAME} . $path;
+    $env->{REQUEST_URI} =~ s|//|/|g;
+    my $response_cb = $c->response->_response_cb;
+    my $class = ref($c) || $c;
 
-    $inner_ctx->stash($stash || {});
-    
-    
     $c->stats->profile(
-        begin   => 'subrequest: /' . $path,
+        begin   => 'subrequest: ' . $path,
         comment => '',
-    ) if ($c->debug); 
-        
-    $inner_ctx->dispatch;
+    ) if ($c->debug);
+
+    my $i_ctx = $class->prepare(env => $env, response_cb => $response_cb);
+    $i_ctx->stash($stash);
+    $i_ctx->dispatch;
+    $i_ctx->finalize;
 
-    $c->stats->profile( end => 'subrequest: /' . $path ) if ($c->debug);
-    
-    return $inner_ctx->response->body;
+    $c->stats->profile( end => 'subrequest: ' . $path ) if $c->debug;
+
+    return $i_ctx->response;
 }
 
 =head1 SEE ALSO
 
 L<Catalyst>.
 
-=head1 AUTHOR
+=head1 AUTHORS
 
 Marcus Ramberg, C<mramberg@cpan.org>
 
+Tomas Doran (t0m) C<< bobtfish@bobtfish.net >>
+
+=head1 MAINTAINERS
+
+Eden Cardim (edenc) C<eden@insoli.de>
+
 =head1 THANK YOU
 
 SRI, for writing the awesome Catalyst framework
+MIYAGAWA, for writing the awesome Plack toolkit
 
 =head1 COPYRIGHT
 
-Copyright (c) 2005 - 2008
-the Catalyst::Plugin::SubRequest L</AUTHOR>
+Copyright (c) 2005 - 2011
+the Catalyst::Plugin::SubRequest L</AUTHORS>
 as listed above.
 
 =head1 LICENSE
@@ -119,23 +138,4 @@ the same terms as Perl itself.
 
 =cut
 
-package # hide from PAUSE
-  Catalyst::Plugin::SubRequest::Internal::FakeEngine;
-
-sub AUTOLOAD { return 1; } # yeah yeah yeah
-
-sub prepare {
-    my ($self, $c) = @_;
-    my $req = $c->request;
-    
-    @{$req}{keys %{$self->{orig_request}}} = values %{$self->{orig_request}};
-    while (my ($key,$value) = each %{$self->{request_mods}}) {
-        if (my $mut = $req->can($key)) {
-            $req->$mut($value);
-        } else {
-            $req->{$key} = $value;
-        }
-    }
-}
-
 1;