SubRequest.pm

   1 package Catalyst::Plugin::SubRequest;
   2
   3 use strict;
   4 use Time::HiRes qw/tv_interval/;
   5
   6 our $VERSION = '0.11';
   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     $c->subreq(        {       path            => '/test/foo/bar',
  19                        body            => $body        },
  20                {       template        => 'magic.tt'           });
  21
  22 =head1 DESCRIPTION
  23
  24 Make subrequests to actions in Catalyst. Uses the  catalyst
  25 dispatcher, so it will work like an external url call.
  26
  27 =head1 METHODS
  28
  29 =over 4
  30
  31 =item subreq [path as string or hash ref], [stash as hash ref], [parameters as hash ref]
  32
  33 =item sub_request
  34
  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.
  38
  39 =back
  40
  41 =cut
  42
  43 *subreq = \&sub_request;
  44
  45 sub sub_request {
  46     my ( $c, $path, $stash, $params ) = @_;
  47
  48     $path =~ s#^/##;
  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 || {});
  83
  84     $inner_ctx->dispatch;
  85
  86     if ($c->debug) {
  87         $inner_ctx->stats->setNodeValue({
  88             action => 'subrequest:',
  89             comment => '',
  90             elapsed => sprintf('%fs', tv_interval($inner_ctx->stats->getNodeValue)),
  91         });
  92         $c->stats->addChild($inner_ctx->stats);
  93     }
  94
  95     return $inner_ctx->response->body;
  96 }
  97
  98 =head1 SEE ALSO
  99
 100 L<Catalyst>.
 101
 102 =head1 AUTHOR
 103
 104 Marcus Ramberg, C<mramberg@cpan.org>
 105
 106 =head1 THANK YOU
 107
 108 SRI, for writing the awesome Catalyst framework
 109
 110 =head1 COPYRIGHT
 111
 112 This program is free software, you can redistribute it and/or modify it under
 113 the same terms as Perl itself.
 114
 115 =cut
 116
 117 package # hide from PAUSE
 118   Catalyst::Plugin::SubRequest::Internal::FakeEngine;
 119
 120 sub AUTOLOAD { return 1; } # yeah yeah yeah
 121
 122 sub prepare {
 123     my ($self, $c) = @_;
 124     my $req = $c->request;
 125     my %attrs = (%{$self->{orig_request}}, %{$self->{request_mods}});
 126     @{$req}{keys %attrs} = values %attrs;
 127 }
 128
 129 1;