File Coverage

blib/lib/HTTP/Session/State/Mixin/ResponseFilter.pm
Criterion Covered Total %
statement 35 37 94.5
branch 16 20 80.0
condition 5 5 100.0
subroutine 4 4 100.0
pod 0 1 0.0
total 60 67 89.5


line stmt bran cond sub pod time code
1             package HTTP::Session::State::Mixin::ResponseFilter;
2 3     3   16 use strict;
  3         7  
  3         79  
3 3     3   19 use warnings;
  3         6  
  3         65  
4 3     3   19 use Exporter 'import';
  3         6  
  3         948  
5             our @EXPORT_OK = qw/response_filter/;
6              
7             sub response_filter {
8 9     9 0 710 my ($self, $session_id, $res) = @_;
9 9 100       79 Carp::croak "missing session_id" unless $session_id;
10              
11 8 100       26 if (Scalar::Util::blessed $res) {
12 6 100 100     16 if ($res->code == 302) {
    100 100        
13 2 100       19 if (my $uri = $res->header('Location')) {
14 1         41 $res->header('Location' => $self->redirect_filter($session_id, $uri));
15             }
16 2         97 return $res;
17             } elsif ($res->content && ($res->header('Content-Type')||'text/html') =~ /html/) {
18 2         175 $res->content( $self->html_filter($session_id, $res->content) );
19 2         3817 return $res;
20             } else {
21 2         78 return $res; # nop
22             }
23             } else {
24             # psgi
25 2 100       7 if ($res->[0] == 302) {
    50          
26 1         2 my @headers = @{ $res->[1] }; # copy
  1         2  
27 1         2 my @new_headers;
28 1         4 while ( my ( $key, $val ) = splice @headers, 0, 2 ) {
29 1 50       3 if (lc($key) eq 'location') {
30 1         4 $val = $self->redirect_filter($session_id, $val);
31             }
32 1         13 push @new_headers, $key, $val;
33             }
34 1         3 $res->[1] = \@new_headers;
35 1         4 return $res;
36             } elsif (my $body = $res->[2]) {
37 1 50       5 if ( ref $body eq 'ARRAY' ) {
38             # TODO: look the content-type header.
39 1         3 my $content = '';
40 1         2 for my $line (@$body) {
41 1 50       4 $content .= $line if length $line;
42             }
43 1         3 $res->[2] = [$self->html_filter($session_id, $content)];
44 1         314 return $res;
45             } else { # HTTP::Session should not process glob.
46 0           return $res;
47             }
48             } else {
49 0           return $res; # nop
50             }
51             }
52             }
53              
54             1;