[Catalyst-commits] r9104 - in Catalyst-Plugin-Compress: . 0.001
0.001/lib 0.001/lib/Catalyst 0.001/lib/Catalyst/Plugin 0.001/t
xinming at dev.catalyst.perl.org
xinming at dev.catalyst.perl.org
Mon Jan 19 15:09:51 GMT 2009
Author: xinming
Date: 2009-01-19 15:09:51 +0000 (Mon, 19 Jan 2009)
New Revision: 9104
Added:
Catalyst-Plugin-Compress/0.001/
Catalyst-Plugin-Compress/0.001/Makefile.PL
Catalyst-Plugin-Compress/0.001/lib/
Catalyst-Plugin-Compress/0.001/lib/Catalyst/
Catalyst-Plugin-Compress/0.001/lib/Catalyst/Plugin/
Catalyst-Plugin-Compress/0.001/lib/Catalyst/Plugin/Compress.pm
Catalyst-Plugin-Compress/0.001/t/
Catalyst-Plugin-Compress/0.001/t/01use.t
Catalyst-Plugin-Compress/0.001/t/02pod.t
Catalyst-Plugin-Compress/0.001/t/03podcoverage.t
Log:
0.001 version of Catalyst-Plugin-Compress.
Added: Catalyst-Plugin-Compress/0.001/Makefile.PL
===================================================================
--- Catalyst-Plugin-Compress/0.001/Makefile.PL (rev 0)
+++ Catalyst-Plugin-Compress/0.001/Makefile.PL 2009-01-19 15:09:51 UTC (rev 9104)
@@ -0,0 +1,12 @@
+use strict;
+use warnings;
+use inc::Module::Install 0.65;
+
+name 'Catalyst-Plugin-Compress';
+all_from 'lib/Catalyst/Plugin/Compress.pm';
+
+requires 'Catalyst::Runtime' => '5.7006';
+
+auto_install;
+WriteAll;
+
Added: Catalyst-Plugin-Compress/0.001/lib/Catalyst/Plugin/Compress.pm
===================================================================
--- Catalyst-Plugin-Compress/0.001/lib/Catalyst/Plugin/Compress.pm (rev 0)
+++ Catalyst-Plugin-Compress/0.001/lib/Catalyst/Plugin/Compress.pm 2009-01-19 15:09:51 UTC (rev 9104)
@@ -0,0 +1,158 @@
+package Catalyst::Plugin::Compress;
+
+use strict;
+use Catalyst::Utils;
+use NEXT;
+
+my $_method;
+my %_compression_lib = (
+ gzip => 'Compress::Zlib',
+ deflate => 'Compress::Zlib',
+ bzip2 => 'Compress::Bzip2',
+);
+
+sub _gzip_compress {
+ Compress::Zlib::memGzip(shift);
+}
+
+sub _bzip2_compress {
+ Compress::Bzip2::memBzip(shift);
+}
+
+sub _deflate_compress {
+ my $content = shift;
+ my $result;
+
+ my ($d, $out, $status);
+ ($d, $status) = Compress::Zlib::deflateInit(
+ -WindowBits => -Compress::Zlib::MAX_WBITS(),
+ );
+ unless ($status == Compress::Zlib::Z_OK()) {
+ die("Cannot create a deflation stream. Error: $status");
+ }
+
+ ($out, $status) = $d->deflate($content);
+ unless ($status == Compress::Zlib::Z_OK()) {
+ die("Deflation failed. Error: $status");
+ }
+ $result .= $out;
+
+ ($out, $status) = $d->flush;
+ unless ($status == Compress::Zlib::Z_OK()) {
+ die("Deflation failed. Error: $status");
+ }
+
+ return $result . $out;
+}
+
+sub setup {
+ my $c = shift;
+ if ($_method = $c->config->{compression_format}) {
+ $_method = 'gzip'
+ if $_method eq 'zlib';
+
+ my $lib_name = $_compression_lib{$_method};
+ die qq{No compression_format named "$_method"}
+ unless $lib_name;
+ Catalyst::Utils::ensure_class_loaded($lib_name);
+
+ *_do_compress = \&{"_${_method}_compress"};
+ }
+ $c->NEXT::setup(@_);
+}
+
+sub finalize {
+ my $c = shift;
+
+ if ((not defined $_method)
+ or $c->res->content_encoding
+ or (not $c->res->body)
+ or ($c->res->status != 200)
+ or ($c->res->content_type !~ /^text|xml$|javascript$/)
+ ) {
+ return $c->NEXT::finalize;
+ }
+
+ my $accept = $c->request->header('Accept-Encoding') || '';
+
+ unless (index($accept, $_method) >= 0) {
+ return $c->NEXT::finalize;
+ }
+
+ my $body = $c->res->body;
+ if (ref $body) {
+ eval { local $/; $body = <$body> };
+ die "Unknown type of ref in body."
+ if ref $body;
+ }
+
+ my $compressed = _do_compress($body);
+ $c->response->body($compressed);
+ $c->response->content_length(length($compressed));
+ $c->response->content_encoding($_method);
+ $c->response->headers->push_header('Vary', 'Accept-Encoding');
+
+ $c->NEXT::finalize;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Catalyst::Plugin::Compress - Compress response
+
+=head1 SYNOPSIS
+
+ use Catalyst qw/Compress/;
+
+or
+
+ use Catalyst qw/
+ Unicode
+ Compress
+ /;
+
+If you want use this plugin with L<Catalyst::Plugin::Unicode>.
+
+And specify compression format with:
+
+ __PACKAGE__->config(
+ compression_format => $format,
+ );
+
+$format can be either gzip bzip2 zlib or deflate.
+
+=head1 DESCRIPTION
+
+Compress response to [gzip bzip2 zlib deflate] if client supports it.
+
+B<NOTE>: If you want to use this module with L<Catalyst::Plugin::Unicode>, You
+B<MUST> load this plugin B<AFTER> L<Catalyst::Plugin::Unicode>.
+
+ use Catalyst qw/
+ Unicode
+ Compress::Deflate
+ /;
+
+If you don't, You'll get error which is like:
+
+[error] Caught exception in engine "Wide character in subroutine entry at
+/usr/lib/perl5/site_perl/5.8.8/Compress/Zlib.pm line xxx."
+
+=head1 SEE ALSO
+
+L<Catalyst>.
+
+=head1 AUTHOR
+
+Yiyi Hu C<yiyihu at gmail.com>
+
+=head1 LICENSE
+
+This library is free software . You can redistribute it and/or modify it under
+the same terms as perl itself.
+
+=cut
+
Added: Catalyst-Plugin-Compress/0.001/t/01use.t
===================================================================
--- Catalyst-Plugin-Compress/0.001/t/01use.t (rev 0)
+++ Catalyst-Plugin-Compress/0.001/t/01use.t 2009-01-19 15:09:51 UTC (rev 9104)
@@ -0,0 +1,4 @@
+use Test::More tests => 1;
+
+use_ok('Catalyst::Plugin::Compress');
+
Added: Catalyst-Plugin-Compress/0.001/t/02pod.t
===================================================================
--- Catalyst-Plugin-Compress/0.001/t/02pod.t (rev 0)
+++ Catalyst-Plugin-Compress/0.001/t/02pod.t 2009-01-19 15:09:51 UTC (rev 9104)
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
Added: Catalyst-Plugin-Compress/0.001/t/03podcoverage.t
===================================================================
--- Catalyst-Plugin-Compress/0.001/t/03podcoverage.t (rev 0)
+++ Catalyst-Plugin-Compress/0.001/t/03podcoverage.t 2009-01-19 15:09:51 UTC (rev 9104)
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_coverage_ok();
More information about the Catalyst-commits
mailing list