SubRequest.pm

   1 package Catalyst::Plugin::SubRequest;
   2
   3 use strict;
   4
   5 our $VERSION = '0.11';
   6
   7 =head1 NAME
   8
   9 Catalyst::Plugin::SubRequest - Make subrequests to actions in Catalyst
  10
  11 =head1 SYNOPSIS
  12
  13     use Catalyst 'SubRequest';
  14
  15     $c->subreq('/test/foo/bar', { template => 'magic.tt' });
  16
  17 =head1 DESCRIPTION
  18
  19 Make subrequests to actions in Catalyst. Uses the  catalyst
  20 dispatcher, so it will work like an external url call.
  21
  22 =head1 METHODS
  23
  24 =over 4
  25
  26 =item subreq path, [stash as hash ref], [parameters as hash ref]
  27
  28 =item sub_request
  29
  30 Takes a full path to a path you'd like to dispatch to. Any additional
  31 parameters are put into the stash.
  32
  33 =back
  34
  35 =cut
  36
  37 *subreq = \&sub_request;
  38
  39 sub sub_request {
  40     my ( $c, $path, $stash, $params ) = @_;
  41
  42     $path =~ s#^/##;
  43
  44     $params ||= {};
  45
  46     my %request_mods = (
  47         body => undef,
  48         action => undef,
  49         match => undef,
  50         parameters => $params,
  51     );
  52
  53     if (ref $path eq 'HASH') {
  54         @request_mods{keys %$path} = values %$path;
  55     } else {
  56         $request_mods{path} = $path;
  57     }
  58
  59     my $fake_engine = bless(
  60         {
  61             orig_request => $c->req,
  62             request_mods => \%request_mods,
  63         },
  64         'Catalyst::Plugin::SubRequest::Internal::FakeEngine'
  65     );
  66
  67     my $class = ref($c);
  68
  69     no strict 'refs';
  70     no warnings 'redefine';
  71
  72     local *{"${class}::engine"} = sub { $fake_engine };
  73
  74     my $inner_ctx = $class->prepare;
  75
  76     $inner_ctx->stash($stash || {});
  77
  78     $inner_ctx->dispatch;
  79     return $inner_ctx->response->body;
  80 }
  81
  82 =head1 SEE ALSO
  83
  84 L<Catalyst>.
  85
  86 =head1 AUTHOR
  87
  88 Marcus Ramberg, C<mramberg@cpan.org>
  89
  90 =head1 THANK YOU
  91
  92 SRI, for writing the awesome Catalyst framework
  93
  94 =head1 COPYRIGHT
  95
  96 This program is free software, you can redistribute it and/or modify it under
  97 the same terms as Perl itself.
  98
  99 =cut
 100
 101 package # hide from PAUSE
 102   Catalyst::Plugin::SubRequest::Internal::FakeEngine;
 103
 104 sub AUTOLOAD { return 1; } # yeah yeah yeah
 105
 106 sub prepare {
 107     my ($self, $c) = @_;
 108     my $req = $c->request;
 109     my %attrs = (%{$self->{orig_request}}, %{$self->{request_mods}});
 110     @{$req}{keys %attrs} = values %attrs;
 111 }
 112
 113 1;