lib/Catalyst/Plugin/SubRequest.pm

   1 package Catalyst::Plugin::SubRequest;
   2
   3 use strict;
   4 use warnings;
   5 use Plack::Request;
   6
   7 our $VERSION = '0.21';
   8
   9 =head1 NAME
  10
  11 Catalyst::Plugin::SubRequest - Make subrequests to actions in Catalyst
  12
  13 =head1 SYNOPSIS
  14
  15     use Catalyst 'SubRequest';
  16
  17     my $res_body = $c->subreq('/test/foo/bar', { template => 'magic.tt' });
  18
  19     my $res_body = $c->subreq( {
  20        path            => '/test/foo/bar',
  21        body            => $body
  22     }, {
  23        template        => 'magic.tt'
  24     });
  25
  26     # Get the full response object
  27     my $res = $c->subreq_res('/test/foo/bar', {
  28         template => 'mailz.tt'
  29     }, {
  30         param1   => 23
  31     });
  32     $c->log->warn( $res->content_type );
  33
  34 =head1 DESCRIPTION
  35
  36 Make subrequests to actions in Catalyst. Uses the  catalyst
  37 dispatcher, so it will work like an external url call.
  38 Methods are provided both to get the body of the response and the full
  39 response (L<Catalyst::Response>) object.
  40
  41 =head1 METHODS
  42
  43 =over 4
  44
  45 =item subreq [path as string or hash ref], [stash as hash ref], [parameters as hash ref]
  46
  47 =item subrequest
  48
  49 =item sub_request
  50
  51 Takes a full path to a path you'd like to dispatch to.
  52
  53 If the path is passed as a hash ref then it can include body, action,
  54 match and path.
  55
  56 An optional second argument as hashref can contain data to put into the
  57 stash of the subrequest.
  58
  59 An optional third argument as hashref can contain data to pass as
  60 parameters to the subrequest.
  61
  62 Returns the body of the response.
  63
  64 =item subreq_res [path as string or hash ref], [stash as hash ref], [parameters as hash ref]
  65
  66 =item subrequest_response
  67
  68 =item sub_request_response
  69
  70 Like C<sub_request()>, but returns a full L<Catalyst::Response> object.
  71
  72 =back
  73
  74 =cut
  75
  76 *subreq              = \&sub_request;
  77 *subrequest          = \&sub_request;
  78 *subreq_res          = \&sub_request_response;
  79 *subrequest_response = \&sub_request_response;
  80
  81 sub sub_request {
  82   return shift->sub_request_response(@_)->body;
  83 }
  84
  85 sub sub_request_response {
  86   my ( $c, $path, $stash, $params ) = @_;
  87   $stash ||= {};
  88   my $env = $c->request->env;
  89   my $req = Plack::Request->new($env);
  90   my $uri = $req->uri;
  91   $uri->query_form( $params || {} );
  92   local $env->{QUERY_STRING} = $uri->query || '';
  93   local $env->{PATH_INFO}    = $path;
  94   local $env->{REQUEST_URI}  = $env->{SCRIPT_NAME} . $path;
  95
  96   # Jump through a few hoops for backcompat with pre 5.9007x
  97   local($env->{&Catalyst::Middleware::Stash::PSGI_KEY}) = &Catalyst::Middleware::Stash::_create_stash()
  98     if $INC{'Catalyst/Middleware/Stash.pm'};
  99
 100   $env->{REQUEST_URI} =~ s|//|/|g;
 101   my $class = ref($c) || $c;
 102
 103   $c->stats->profile(
 104     begin   => 'subrequest: ' . $path,
 105     comment => '',
 106   ) if ( $c->debug );
 107
 108   # need this so that
 109   my $writer = Catalyst::Plugin::SubRequest::Writer->new;
 110   my $response_cb = sub {
 111     my $response = shift;
 112     my ($status, $headers, $body) = @$response;
 113     if($body) {
 114       return;
 115     } else {
 116       return $writer;
 117     }
 118   };
 119
 120   my $i_ctx = $class->prepare( env => $env, response_cb => $response_cb );
 121   $i_ctx->stash($stash);
 122   $i_ctx->dispatch;
 123   $i_ctx->finalize;
 124   $c->stats->profile( end => 'subrequest: ' . $path ) if $c->debug;
 125
 126   if($writer->_is_closed) {
 127     $i_ctx->response->body($writer->body);
 128   }
 129
 130   return $i_ctx->response;
 131 }
 132
 133
 134 package Catalyst::Plugin::SubRequest::Writer;
 135 use Moose;
 136 has body => (
 137   isa     => 'Str',
 138   is      => 'ro',
 139   traits  => ['String'],
 140   default => '',
 141   handles => { write => 'append' }
 142 );
 143 has _is_closed => ( isa => 'Bool', is => 'rw', default => 0 );
 144 sub close { shift->_is_closed(1) }
 145
 146 around write => sub {
 147   my $super = shift;
 148   my $self = shift;
 149   return if $self->_is_closed;
 150   $self->$super(@_);
 151 };
 152
 153 =head1 SEE ALSO
 154
 155 L<Catalyst>.
 156
 157 =head1 AUTHORS
 158
 159 Marcus Ramberg, C<mramberg@cpan.org>
 160
 161 Tomas Doran (t0m) C<< bobtfish@bobtfish.net >>
 162
 163 =head1 MAINTAINERS
 164
 165 Eden Cardim (edenc) C<eden@insoli.de>
 166
 167 =head1 THANK YOU
 168
 169 SRI, for writing the awesome Catalyst framework
 170
 171 MIYAGAWA, for writing the awesome Plack toolkit
 172
 173 =head1 COPYRIGHT
 174
 175 Copyright (c) 2005 - 2011
 176 the Catalyst::Plugin::SubRequest L</AUTHORS>
 177 as listed above.
 178
 179 =head1 LICENSE
 180
 181 This program is free software, you can redistribute it and/or modify it under
 182 the same terms as Perl itself.
 183
 184 =cut
 185
 186 1;