Commit | Line | Data |
aae30f91 |
1 | package Catalyst::Plugin::SubRequest; |
2 | |
3 | use strict; |
588fd7ac |
4 | use Time::HiRes qw/tv_interval/; |
aae30f91 |
5 | |
85ec975f |
6 | our $VERSION = '0.14'; |
aae30f91 |
7 | |
aae30f91 |
8 | =head1 NAME |
9 | |
10 | Catalyst::Plugin::SubRequest - Make subrequests to actions in Catalyst |
11 | |
12 | =head1 SYNOPSIS |
13 | |
14 | use Catalyst 'SubRequest'; |
15 | |
885f6da0 |
16 | $c->subreq('/test/foo/bar', { template => 'magic.tt' }); |
aae30f91 |
17 | |
4f38f6a7 |
18 | $c->subreq( { path => '/test/foo/bar', |
19 | body => $body }, |
20 | { template => 'magic.tt' }); |
21 | |
aae30f91 |
22 | =head1 DESCRIPTION |
23 | |
8c464987 |
24 | Make subrequests to actions in Catalyst. Uses the catalyst |
25 | dispatcher, so it will work like an external url call. |
aae30f91 |
26 | |
27 | =head1 METHODS |
28 | |
29 | =over 4 |
30 | |
4f38f6a7 |
31 | =item subreq [path as string or hash ref], [stash as hash ref], [parameters as hash ref] |
aae30f91 |
32 | |
33 | =item sub_request |
34 | |
4f38f6a7 |
35 | Takes a full path to a path you'd like to dispatch to. |
36 | If the path is passed as a hash ref then it can include body, action, match and path. |
37 | Any additional parameters are put into the stash. |
aae30f91 |
38 | |
39 | =back |
40 | |
41 | =cut |
42 | |
43 | *subreq = \&sub_request; |
44 | |
45 | sub sub_request { |
885f6da0 |
46 | my ( $c, $path, $stash, $params ) = @_; |
8c464987 |
47 | |
5bd316a5 |
48 | $path =~ s#^/##; |
29ec3000 |
49 | |
50 | $params ||= {}; |
51 | |
52 | my %request_mods = ( |
53 | body => undef, |
54 | action => undef, |
55 | match => undef, |
56 | parameters => $params, |
57 | ); |
58 | |
59 | if (ref $path eq 'HASH') { |
60 | @request_mods{keys %$path} = values %$path; |
61 | } else { |
62 | $request_mods{path} = $path; |
63 | } |
64 | |
65 | my $fake_engine = bless( |
66 | { |
67 | orig_request => $c->req, |
68 | request_mods => \%request_mods, |
69 | }, |
70 | 'Catalyst::Plugin::SubRequest::Internal::FakeEngine' |
71 | ); |
72 | |
73 | my $class = ref($c); |
74 | |
75 | no strict 'refs'; |
76 | no warnings 'redefine'; |
77 | |
78 | local *{"${class}::engine"} = sub { $fake_engine }; |
79 | |
80 | my $inner_ctx = $class->prepare; |
81 | |
82 | $inner_ctx->stash($stash || {}); |
eed0c36b |
83 | |
eed0c36b |
84 | |
6162c29a |
85 | $c->stats->profile( |
86 | begin => 'subrequest: /' . $path, |
87 | comment => '', |
88 | ) if ($c->debug); |
89 | |
90 | $inner_ctx->dispatch; |
91 | |
92 | $c->stats->profile( end => 'subrequest: /' . $path ) if ($c->debug); |
588fd7ac |
93 | |
29ec3000 |
94 | return $inner_ctx->response->body; |
aae30f91 |
95 | } |
96 | |
97 | =head1 SEE ALSO |
98 | |
99 | L<Catalyst>. |
100 | |
101 | =head1 AUTHOR |
102 | |
103 | Marcus Ramberg, C<mramberg@cpan.org> |
104 | |
105 | =head1 THANK YOU |
106 | |
107 | SRI, for writing the awesome Catalyst framework |
108 | |
109 | =head1 COPYRIGHT |
110 | |
85ec975f |
111 | Copyright (c) 2005 - 2008 |
112 | the Catalyst::Plugin::SubRequest L</AUTHOR> |
113 | as listed above. |
114 | |
115 | =head1 LICENSE |
116 | |
aae30f91 |
117 | This program is free software, you can redistribute it and/or modify it under |
118 | the same terms as Perl itself. |
119 | |
120 | =cut |
121 | |
29ec3000 |
122 | package # hide from PAUSE |
123 | Catalyst::Plugin::SubRequest::Internal::FakeEngine; |
124 | |
125 | sub AUTOLOAD { return 1; } # yeah yeah yeah |
126 | |
127 | sub prepare { |
128 | my ($self, $c) = @_; |
129 | my $req = $c->request; |
cc9f9d31 |
130 | |
131 | @{$req}{keys %{$self->{orig_request}}} = values %{$self->{orig_request}}; |
132 | while (my ($key,$value) = each %{$self->{request_mods}}) { |
597f0a02 |
133 | if (my $mut = $req->can($key)) { |
134 | $req->$mut($value); |
135 | } else { |
136 | $req->{$key} = $value; |
137 | } |
138 | } |
29ec3000 |
139 | } |
140 | |
aae30f91 |
141 | 1; |