1package Web::Machine::Util::BodyEncoding; 2# ABSTRACT: Module to handle body encoding 3 4use strict; 5use warnings; 6 7our $VERSION = '0.17'; 8 9use Scalar::Util qw/ weaken isweak /; 10use Encode (); 11use Web::Machine::Util qw[ first pair_key pair_value ]; 12 13use Sub::Exporter -setup => { 14 exports => [qw[ 15 encode_body_if_set 16 encode_body 17 ]] 18}; 19 20sub encode_body_if_set { 21 my ($resource, $response) = @_; 22 encode_body( $resource, $response ) if $response->body; 23} 24 25sub encode_body { 26 my ($resource, $response) = @_; 27 28 my $metadata = $resource->request->env->{'web.machine.context'}; 29 my $chosen_encoding = $metadata->{'Content-Encoding'}; 30 my $encoder = $resource->encodings_provided->{ $chosen_encoding }; 31 32 my $chosen_charset = $metadata->{'Charset'}; 33 my $charsetter; 34 if ( $chosen_charset && $resource->charsets_provided ) { 35 my $match = first { 36 my $name = $_ && ref $_ ? pair_key($_) : $_; 37 $name && $name eq $chosen_charset; 38 } 39 @{ $resource->charsets_provided }; 40 41 $charsetter 42 = ref $match 43 ? pair_value($match) 44 : sub { Encode::encode( $match, $_[1] ) }; 45 } 46 47 $charsetter ||= sub { $_[1] }; 48 49 push @{ $resource->request->env->{'web.machine.content_filters'} ||= [] }, 50 sub { 51 my $chunk = shift; 52 weaken $resource unless isweak $resource; 53 return unless defined $chunk; 54 return $resource->$encoder($resource->$charsetter($chunk)); 55 }; 56} 57 58 591; 60 61__END__ 62 63=pod 64 65=encoding UTF-8 66 67=head1 NAME 68 69Web::Machine::Util::BodyEncoding - Module to handle body encoding 70 71=head1 VERSION 72 73version 0.17 74 75=head1 SYNOPSIS 76 77 use Web::Machine::Util::BodyEncoding; 78 79=head1 DESCRIPTION 80 81This handles the body encoding. 82 83=head1 FUNCTIONS 84 85=over 4 86 87=item C<encode_body_if_set ( $resource, $response, $metadata )> 88 89If the C<$response> has a body, this will call C<encode_body>. 90 91=item C<encode_body ( $resource, $response, $metadata )> 92 93This will find the right encoding (from the 'Content-Encoding' entry 94in the C<$metadata> HASH ref) and the right charset (from the 'Charset' 95entry in the C<$metadata> HASH ref), then find the right transformers 96in the C<$resource>. After that it will attempt to convert the charset 97and encode the body of the C<$response>. Once completed it will set 98the C<Content-Length> header in the response as well. 99 100B<CAVEAT:> Note that currently this subroutine doesn't do anything when the 101body is returned as a CODE ref. This is a bug to be remedied in the future. 102 103=back 104 105=head1 SUPPORT 106 107bugs may be submitted through L<https://github.com/houseabsolute/webmachine-perl/issues>. 108 109=head1 AUTHORS 110 111=over 4 112 113=item * 114 115Stevan Little <stevan@cpan.org> 116 117=item * 118 119Dave Rolsky <autarch@urth.org> 120 121=back 122 123=head1 COPYRIGHT AND LICENCE 124 125This software is copyright (c) 2016 by Infinity Interactive, Inc. 126 127This is free software; you can redistribute it and/or modify it under 128the same terms as the Perl 5 programming language system itself. 129 130=cut 131