lib/Catalyst/Plugin/SubRequest.pm

   1 package Catalyst::Plugin::SubRequest;
   2
   3 use strict;
   4 use Time::HiRes qw/tv_interval/;
   5
   6 our $VERSION = '0.14';
   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
  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);
  93
  94     return $inner_ctx->response->body;
  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
 111 Copyright (c) 2005 - 2008
 112 the Catalyst::Plugin::SubRequest L</AUTHOR>
 113 as listed above.
 114
 115 =head1 LICENSE
 116
 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
 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;
 130
 131     @{$req}{keys %{$self->{orig_request}}} = values %{$self->{orig_request}};
 132     while (my ($key,$value) = each %{$self->{request_mods}}) {
 133         if (my $mut = $req->can($key)) {
 134             $req->$mut($value);
 135         } else {
 136             $req->{$key} = $value;
 137         }
 138     }
 139 }
 140
 141 1;