diff options
-rw-r--r-- | perllib/Catalyst/Plugin/Compress/Gzip.pm | 82 | ||||
-rw-r--r-- | perllib/FixMyStreet/App.pm | 1 |
2 files changed, 83 insertions, 0 deletions
diff --git a/perllib/Catalyst/Plugin/Compress/Gzip.pm b/perllib/Catalyst/Plugin/Compress/Gzip.pm new file mode 100644 index 000000000..06532c84c --- /dev/null +++ b/perllib/Catalyst/Plugin/Compress/Gzip.pm @@ -0,0 +1,82 @@ +package Catalyst::Plugin::Compress::Gzip; +use strict; +use warnings; +use MRO::Compat; + +use Compress::Zlib (); + +sub finalize_headers { + my $c = shift; + + if ( $c->response->content_encoding ) { + return $c->next::method(@_); + } + + unless ( $c->response->body ) { + return $c->next::method(@_); + } + + unless ( $c->response->status == 200 ) { + return $c->next::method(@_); + } + + unless ( $c->response->content_type =~ /^text|xml$|javascript$/ ) { + return $c->next::method(@_); + } + + my $accept = $c->request->header('Accept-Encoding') || ''; + + unless ( index( $accept, "gzip" ) >= 0 ) { + return $c->next::method(@_); + } + + + my $body = $c->response->body; + eval { local $/; $body = <$body> } if ref $body; + die "Response body is an unsupported kind of reference" if ref $body; + + $c->response->body( Compress::Zlib::memGzip( $body ) ); + $c->response->content_length( length( $c->response->body ) ); + $c->response->content_encoding('gzip'); + $c->response->headers->push_header( 'Vary', 'Accept-Encoding' ); + + $c->next::method(@_); +} + +1; + +__END__ + +=head1 NAME + +Catalyst::Plugin::Compress::Gzip - Gzip response + +=head1 SYNOPSIS + + use Catalyst qw[Compress::Gzip]; + + +=head1 DESCRIPTION + +Gzip compress response if client supports it. Changed from CPAN version to +overload finalize_headers, rather than finalize. + +=head1 METHODS + +=head2 finalize_headers + +=head1 SEE ALSO + +L<Catalyst>. + +=head1 AUTHOR + +Christian Hansen, C<ch@ngmedia.com> +Matthew Somerville. + +=head1 LICENSE + +This library is free software . You can redistribute it and/or modify it under +the same terms as perl itself. + +=cut diff --git a/perllib/FixMyStreet/App.pm b/perllib/FixMyStreet/App.pm index 3d7458e2a..205732caf 100644 --- a/perllib/FixMyStreet/App.pm +++ b/perllib/FixMyStreet/App.pm @@ -27,6 +27,7 @@ use Catalyst ( 'Session::State::Cookie', # FIXME - we're using our own override atm 'Authentication', 'SmartURI', + 'Compress::Gzip', ); extends 'Catalyst'; |