File Coverage

blib/lib/Plack/Middleware/Recursive.pm
Criterion Covered Total %
statement 55 58 94.8
branch 8 10 80.0
condition 4 9 44.4
subroutine 15 16 93.7
pod 1 2 50.0
total 83 95 87.3


line stmt bran cond sub pod time code
1             package Plack::Middleware::Recursive;
2 4     4   95836 use strict;
  4         10  
  4         133  
3 4     4   22 use parent qw(Plack::Middleware);
  4         9  
  4         26  
4              
5 4     4   2231 use Try::Tiny;
  4         8528  
  4         228  
6 4     4   28 use Scalar::Util qw(blessed);
  4         9  
  4         2336  
7              
8 4     4   25 open my $null_io, "<", \"";
  4         9  
  4         29  
9              
10             sub call {
11 9     9 1 25 my($self, $env) = @_;
12              
13 9         39 $env->{'plack.recursive.include'} = $self->recurse_callback($env, 1);
14              
15             my $res = try {
16 9     9   469 $self->app->($env);
17             } catch {
18 4 100 66 4   97 if (blessed $_ && $_->isa('Plack::Recursive::ForwardRequest')) {
19 3         13 return $self->recurse_callback($env)->($_->path);
20             } else {
21 1         5 die $_; # rethrow
22             }
23 9         91 };
24              
25 8 100       3041 return $res if ref $res eq 'ARRAY';
26              
27             return sub {
28 4     4   9 my $respond = shift;
29              
30 4         6 my $writer;
31             try {
32 4         176 $res->(sub { return $writer = $respond->(@_) });
  3         910  
33             } catch {
34 1 50 33     38 if (!$writer && blessed $_ && $_->isa('Plack::Recursive::ForwardRequest')) {
      33        
35 1         5 $res = $self->recurse_callback($env)->($_->path);
36 1 50       8 return ref $res eq 'CODE' ? $res->($respond) : $respond->($res);
37             } else {
38 0         0 die $_;
39             }
40 4         50 };
41 4         30 };
42             }
43              
44             sub recurse_callback {
45 13     13 0 50 my($self, $env, $include) = @_;
46              
47 13         37 my $old_path_info = $env->{PATH_INFO};
48              
49             return sub {
50 6     6   28 my $new_path_info = shift;
51 6         29 my($path, $query) = split /\?/, $new_path_info, 2;
52              
53 6         26 Scalar::Util::weaken($env);
54              
55 6         14 $env->{PATH_INFO} = $path;
56 6         17 $env->{QUERY_STRING} = $query;
57 6         10 $env->{REQUEST_METHOD} = 'GET';
58 6         10 $env->{CONTENT_LENGTH} = 0;
59 6         13 $env->{CONTENT_TYPE} = '';
60 6         27 $env->{'psgi.input'} = $null_io;
61 6         19 push @{$env->{'plack.recursive.old_path_info'}}, $old_path_info;
  6         21  
62              
63 6 100       60 $include ? $self->app->($env) : $self->call($env);
64 13         149 };
65             }
66              
67             package Plack::Recursive::ForwardRequest;
68 4     4   33 use overload q("") => \&as_string, fallback => 1;
  4         9  
  4         25  
69              
70             sub new {
71 4     4   11 my($class, $path) = @_;
72 4         32 bless { path => $path }, $class;
73             }
74              
75 4     4   72 sub path { $_[0]->{path} }
76              
77             sub throw {
78 4     4   59 my($class, @args) = @_;
79 4         13 die $class->new(@args);
80             }
81              
82             sub as_string {
83 0     0     my $self = shift;
84 0           return "Forwarding to $self->{path}: Your application should be wrapped with Plack::Middleware::Recursive.";
85             }
86              
87             package Plack::Middleware::Recursive;
88              
89             1;
90              
91             __END__