File Coverage

blib/lib/Web/Machine/Util/BodyEncoding.pm
Criterion Covered Total %
statement 41 41 100.0
branch 13 14 92.8
condition 7 10 70.0
subroutine 12 12 100.0
pod 2 2 100.0
total 75 79 94.9


line stmt bran cond sub pod time code
1             package Web::Machine::Util::BodyEncoding;
2             # ABSTRACT: Module to handle body encoding
3              
4 13     13   43 use strict;
  13         16  
  13         335  
5 13     13   39 use warnings;
  13         15  
  13         422  
6              
7             our $VERSION = '0.17';
8              
9 13     13   43 use Scalar::Util qw/ weaken isweak /;
  13         12  
  13         505  
10 13     13   5426 use Encode ();
  13         77316  
  13         282  
11 13     13   62 use Web::Machine::Util qw[ first pair_key pair_value ];
  13         14  
  13         102  
12              
13 13         91 use Sub::Exporter -setup => {
14             exports => [qw[
15             encode_body_if_set
16             encode_body
17             ]]
18 13     13   3512 };
  13         16  
19              
20             sub encode_body_if_set {
21 7     7 1 8 my ($resource, $response) = @_;
22 7 100       14 encode_body( $resource, $response ) if $response->body;
23             }
24              
25             sub encode_body {
26 36     36 1 53 my ($resource, $response) = @_;
27              
28 36         93 my $metadata = $resource->request->env->{'web.machine.context'};
29 36         88 my $chosen_encoding = $metadata->{'Content-Encoding'};
30 36         66 my $encoder = $resource->encodings_provided->{ $chosen_encoding };
31              
32 36         93 my $chosen_charset = $metadata->{'Charset'};
33 36         27 my $charsetter;
34 36 100 66     88 if ( $chosen_charset && $resource->charsets_provided ) {
35             my $match = first {
36 18 100 66 18   106 my $name = $_ && ref $_ ? pair_key($_) : $_;
37 18 50       71 $name && $name eq $chosen_charset;
38             }
39 14         86 @{ $resource->charsets_provided };
  14         19  
40              
41             $charsetter
42             = ref $match
43             ? pair_value($match)
44 14 100   6   67 : sub { Encode::encode( $match, $_[1] ) };
  6         12  
45             }
46              
47 36   100 125   165 $charsetter ||= sub { $_[1] };
  125         181  
48              
49 36   50     71 push @{ $resource->request->env->{'web.machine.content_filters'} ||= [] },
50             sub {
51 145     145   926 my $chunk = shift;
52 145 100       313 weaken $resource unless isweak $resource;
53 145 100       177 return unless defined $chunk;
54 139         153 return $resource->$encoder($resource->$charsetter($chunk));
55 36         33 };
56             }
57              
58              
59             1;
60              
61             __END__