made SubReq create its own context

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

diff --git a/SubRequest.pm b/SubRequest.pm
index d260034..ab6c5ea 100644 (file)
--- a/SubRequest.pm
+++ b/SubRequest.pm
@@ -2,8 +2,7 @@ package Catalyst::Plugin::SubRequest;
 
 use strict;
 
-our $VERSION = '0.04';
-
+our $VERSION = '0.11';
 
 =head1 NAME
 
@@ -13,7 +12,7 @@ Catalyst::Plugin::SubRequest - Make subrequests to actions in Catalyst
 
     use Catalyst 'SubRequest';
 
-    $c->subreq('/test/foo/bar', template='magic.tt');
+    $c->subreq('/test/foo/bar', { template => 'magic.tt' });
 
 =head1 DESCRIPTION
 
@@ -24,7 +23,7 @@ dispatcher, so it will work like an external url call.
 
 =over 4 
 
-=item subreq path, [stash]
+=item subreq path, [stash as hash ref], [parameters as hash ref]
 
 =item sub_request
 
@@ -37,29 +36,47 @@ parameters are put into the stash.
 
 *subreq = \&sub_request;
 
-use Data::Dumper qw/Dumper/;
 sub sub_request {
-    my ( $c, $path, $stash ) = @_;
-
-    my %old_req;
-    $path =~ s/^\///;
-    $old_req{stash}   = $c->{stash};$c->{stash}=$stash || {};
-    $old_req{content} = $c->res->output;$c->res->output(undef);
-    $old_req{args}    = $c->req->arguments;
-    $old_req{action}  = $c->req->action;$c->req->action(undef);
-    $old_req{path}  = $c->req->path;$c->req->path($path);
-    $old_req{params}  = $c->req->params;$c->req->{params} = {};
-    $c->prepare_action();
-    $c->log->debug("Subrequest to $path , action is ". 
-                   $c->req->action )
-      if $c->debug;
-    $c->dispatch();
-    my $output  = $c->res->output;
-    $c->{stash} = $old_req{stash};
-    $c->req->{params}=$old_req{params};
-    $c->req->arguments($old_req{args});
-    $c->res->output($old_req{content});
-    return $output;
+    my ( $c, $path, $stash, $params ) = @_;
+
+    $path =~ s#^/##;
+
+    $params ||= {};
+
+    my %request_mods = (
+        body => undef,
+        action => undef,
+        match => undef,
+        parameters => $params,
+    );
+
+    if (ref $path eq 'HASH') {
+        @request_mods{keys %$path} = values %$path;
+    } else {
+        $request_mods{path} = $path;
+    }
+
+    my $fake_engine = bless(
+        {
+            orig_request => $c->req,
+            request_mods => \%request_mods,
+        },
+        'Catalyst::Plugin::SubRequest::Internal::FakeEngine'
+    );
+
+    my $class = ref($c);
+
+    no strict 'refs';
+    no warnings 'redefine';
+
+    local *{"${class}::engine"} = sub { $fake_engine };
+
+    my $inner_ctx = $class->prepare;
+
+    $inner_ctx->stash($stash || {});
+
+    $inner_ctx->dispatch;
+    return $inner_ctx->response->body;
 }
 
 =head1 SEE ALSO
@@ -81,4 +98,16 @@ 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;
+    my %attrs = (%{$self->{orig_request}}, %{$self->{request_mods}});
+    @{$req}{keys %attrs} = values %attrs;
+}
+
 1;