File Coverage

blib/lib/Plack/Middleware/FixMissingBodyInRedirect.pm
Criterion Covered Total %
statement 52 52 100.0
branch 19 22 86.3
condition 12 15 80.0
subroutine 10 10 100.0
pod 1 1 100.0
total 94 100 94.0


line stmt bran cond sub pod time code
1             package Plack::Middleware::FixMissingBodyInRedirect;
2 1     1   810 use strict;
  1         2  
  1         33  
3 1     1   5 use warnings;
  1         1  
  1         33  
4 1     1   12 use parent qw( Plack::Middleware );
  1         2  
  1         6  
5              
6 1     1   49 use Plack::Util;
  1         1  
  1         24  
7 1     1   772 use HTML::Entities;
  1         5776  
  1         94  
8 1     1   8 use Scalar::Util qw(blessed);
  1         2  
  1         469  
9             # ABSTRACT: Plack::Middleware which sets body for redirect response, if it's not already set
10              
11             our $VERSION = '0.10';
12              
13             sub call {
14 14     14 1 58082 my $self = shift;
15              
16             return $self->response_cb($self->app->(@_), sub {
17 14     14   2352 my $res = shift;
18 14 50 33     93 return unless $res->[0] >= 300 && $res->[0] < 400;
19 14         42 my $headers = Plack::Util::headers($res->[1]); # first index contains HTTP header
20 14 50       346 if( $headers->exists('Location') ) {
21 14         491 my $location = $headers->get("Location");
22             # checking if body (which is at index 2) is set or not
23 14 100 100     436 if (@$res == 3 && !_is_body_set($res->[2])) {
    100 100        
24 5         16 my $body = $self->_default_html_body($location);
25 5         15 $res->[2] = [$body];
26 5         31 my $content_length = Plack::Util::content_length([$body]);
27 5         82 $headers->set('Content-Length' => $content_length);
28 5         193 $headers->set('Content-Type' => 'text/html; charset=utf-8');
29 5         227 return;
30             }
31             elsif (@$res == 2 || blessed($res->[2])) {
32 4 100       18 if(! $headers->exists('Content-Type')) {
33 2         54 $headers->set('Content-Type' => 'text/html; charset=utf-8')
34             }
35 4         99 my $done;
36             return sub {
37 8         566 my $chunk = shift;
38 8 100       25 return $chunk if $done;
39 4 100       10 if (!defined $chunk) {
    50          
40 2         4 $done = 1;
41 2         6 return $self->_default_html_body($location);
42             }
43             elsif (length $chunk) {
44 2         3 $done = 1;
45             }
46 2         9 return $chunk;
47 4         44 };
48             }
49             }
50 14         53 });
51             }
52              
53             sub _default_html_body {
54 7     7   12 my ($self_or_class, $location) = @_;
55 7         25 my $encoded_location = encode_entities($location);
56 7         108 return <<"EOF";
57             <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
58             <html xmlns="http://www.w3.org/1999/xhtml">
59             <head>
60             <title>Moved</title>
61             </head>
62             <body>
63             <p>This item has moved <a href="$encoded_location">here</a>.</p>
64             </body>
65             </html>
66             EOF
67             }
68              
69             sub _is_body_set {
70 12     12   16 my $body = shift;
71 12 100 66     43 if (ref $body eq 'ARRAY') {
    100 100        
72 8 100       16 return grep { defined && length } @$body;
  11         134  
73             }
74             elsif (Plack::Util::is_real_fh($body) && -f $body && -z _) {
75 1         64 return 0;
76             }
77 3         172 return 1;
78             }
79              
80             1;
81              
82             __END__
83              
84             =pod
85              
86             =encoding UTF-8
87              
88             =head1 NAME
89              
90             Plack::Middleware::FixMissingBodyInRedirect - Plack::Middleware which sets body for redirect response, if it's not already set
91              
92             =head1 VERSION
93              
94             version 0.11
95              
96             =head1 SYNOPSIS
97              
98             use strict;
99             use warnings;
100              
101             use Plack::Builder;
102              
103             my $app = sub { ... };
104              
105             builder {
106             enable "FixMissingBodyInRedirect";
107             $app;
108             };
109              
110             =head1 DESCRIPTION
111              
112             This module sets body in redirect response, if it's not already set.
113              
114             =head1 CONTRIBUTORS
115              
116             John Napiorkowski <jjn1056@yahoo.com>
117              
118             Graham Knop <haarg@haarg.org>
119              
120             n0body, Mark Ellis <m@rkellis.com>
121              
122             ether, Karen Etheridge <ether@cpan.org>
123              
124             =head1 AUTHOR
125              
126             Upasana <me@upasana.me>
127              
128             =head1 COPYRIGHT AND LICENSE
129              
130             This software is copyright (c) 2014 by Upasana.
131              
132             This is free software; you can redistribute it and/or modify it under
133             the same terms as the Perl 5 programming language system itself.
134              
135             =cut