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.20';
   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   $env->{REQUEST_URI} =~ s|//|/|g;
  96   my $class = ref($c) || $c;
  97
  98   $c->stats->profile(
  99     begin   => 'subrequest: ' . $path,
 100     comment => '',
 101   ) if ( $c->debug );
 102
 103   # need this so that
 104   my $writer = Catalyst::Plugin::SubRequest::Writer->new;
 105   my $response_cb = sub { $writer };
 106   my $i_ctx = $class->prepare( env => $env, response_cb => $response_cb );
 107   $i_ctx->stash($stash);
 108   $i_ctx->dispatch;
 109   $i_ctx->finalize;
 110   $c->stats->profile( end => 'subrequest: ' . $path ) if $c->debug;
 111
 112   $i_ctx->response->body($writer->body);
 113
 114   return $i_ctx->response;
 115 }
 116
 117 package Catalyst::Plugin::SubRequest::Writer;
 118 use Moose;
 119 has body => (
 120   isa     => 'Str',
 121   is      => 'ro',
 122   traits  => ['String'],
 123   default => '',
 124   handles => { write => 'append' }
 125 );
 126 has _is_closed => ( isa => 'Bool', is => 'rw', default => 0 );
 127 sub close { shift->_is_closed(1) }
 128
 129 around write => sub {
 130   my $super = shift;
 131   my $self = shift;
 132   return if $self->_is_closed;
 133   $self->$super(@_);
 134 };
 135
 136 =head1 SEE ALSO
 137
 138 L<Catalyst>.
 139
 140 =head1 AUTHORS
 141
 142 Marcus Ramberg, C<mramberg@cpan.org>
 143
 144 Tomas Doran (t0m) C<< bobtfish@bobtfish.net >>
 145
 146 =head1 MAINTAINERS
 147
 148 Eden Cardim (edenc) C<eden@insoli.de>
 149
 150 =head1 THANK YOU
 151
 152 SRI, for writing the awesome Catalyst framework
 153
 154 MIYAGAWA, for writing the awesome Plack toolkit
 155
 156 =head1 COPYRIGHT
 157
 158 Copyright (c) 2005 - 2011
 159 the Catalyst::Plugin::SubRequest L</AUTHORS>
 160 as listed above.
 161
 162 =head1 LICENSE
 163
 164 This program is free software, you can redistribute it and/or modify it under
 165 the same terms as Perl itself.
 166
 167 =cut
 168
 169 1;