SubRequest.pm

   1 package Catalyst::Plugin::SubRequest;
   2
   3 use strict;
   4
   5 our $VERSION = '0.08';
   6
   7
   8 =head1 NAME
   9
  10 Catalyst::Plugin::SubRequest - Make subrequests to actions in Catalyst
  11
  12 =head1 SYNOPSIS
  13
  14     use Catalyst 'SubRequest';
  15
  16     $c->subreq('/test/foo/bar', { template => 'magic.tt' });
  17
  18 =head1 DESCRIPTION
  19
  20 Make subrequests to actions in Catalyst. Uses the  catalyst
  21 dispatcher, so it will work like an external url call.
  22
  23 =head1 METHODS
  24
  25 =over 4
  26
  27 =item subreq path, [stash as hash ref], [parameters as hash ref]
  28
  29 =item sub_request
  30
  31 Takes a full path to a path you'd like to dispatch to. Any additional
  32 parameters are put into the stash.
  33
  34 =back
  35
  36 =cut
  37
  38 *subreq = \&sub_request;
  39
  40 use Data::Dumper qw/Dumper/;
  41 sub sub_request {
  42     my ( $c, $path, $stash, $params ) = @_;
  43
  44     my %old_req;
  45     $path =~ s/^\///;
  46     local $c->{stash}=$stash || {};
  47     $old_req{content} = $c->res->output;$c->res->output(undef);
  48     $old_req{args}    = $c->req->arguments;
  49     $old_req{action}  = $c->req->action;$c->req->action(undef);
  50     $old_req{path}    = $c->req->path;$c->req->path($path);
  51     $old_req{params}  = $c->req->params;$c->req->params($params || {});
  52     $c->prepare_action();
  53     $c->log->debug("Subrequest to $path , action is ".  $c->req->action )
  54         if $c->debug;
  55     # FIXME: Hack until proper patch in NEXT.
  56     local $NEXT::NEXT{$c,'dispatch'};
  57     $c->dispatch();
  58     my $output  = $c->res->output;
  59     $c->req->{params}=$old_req{params};
  60     $c->req->arguments($old_req{args});
  61     $c->req->path($old_req{path});
  62     $c->res->output($old_req{content});
  63     return $output;
  64 }
  65
  66 =head1 SEE ALSO
  67
  68 L<Catalyst>.
  69
  70 =head1 AUTHOR
  71
  72 Marcus Ramberg, C<mramberg@cpan.org>
  73
  74 =head1 THANK YOU
  75
  76 SRI, for writing the awesome Catalyst framework
  77
  78 =head1 COPYRIGHT
  79
  80 This program is free software, you can redistribute it and/or modify it under
  81 the same terms as Perl itself.
  82
  83 =cut
  84
  85 1;