[Catalyst-commits] r13130 - in Catalyst-Plugin-Compress/tags: . 0.005/lib/Catalyst/Plugin

xinming at dev.catalyst.perl.org xinming at dev.catalyst.perl.org
Tue Apr 6 15:40:51 GMT 2010


Author: xinming
Date: 2010-04-06 16:40:51 +0100 (Tue, 06 Apr 2010)
New Revision: 13130

Added:
   Catalyst-Plugin-Compress/tags/0.005/
   Catalyst-Plugin-Compress/tags/0.005/lib/Catalyst/Plugin/Compress.pm
Removed:
   Catalyst-Plugin-Compress/tags/0.005/lib/Catalyst/Plugin/Compress.pm
Log:
Tag C::P::Compress 0.005

Deleted: Catalyst-Plugin-Compress/tags/0.005/lib/Catalyst/Plugin/Compress.pm
===================================================================
--- Catalyst-Plugin-Compress/trunk/lib/Catalyst/Plugin/Compress.pm	2010-04-03 03:04:05 UTC (rev 13127)
+++ Catalyst-Plugin-Compress/tags/0.005/lib/Catalyst/Plugin/Compress.pm	2010-04-06 15:40:51 UTC (rev 13130)
@@ -1,169 +0,0 @@
-package Catalyst::Plugin::Compress;
-
-use strict;
-use Catalyst::Utils;
-use MRO::Compat;
-
-our $VERSION = '0.004';
-
-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"};
-    }
-    if ($c->debug) {
-        $_method
-            ? $c->log->debug(qq{Catalyst::Plugin::Compress sets compression_format to '$_method'})
-            : $c->log->debug(qq{Catalyst::Plugin::Compress has no compression_format config - disabled.});
-    }
-    $c->maybe::next::method(@_);
-}
-
-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|json$/)
-    ) {
-        return $c->maybe::next::method(@_);
-    }
-
-    my $accept = $c->request->header('Accept-Encoding') || '';
-
-    unless (index($accept, $_method) >= 0) {
-        return $c->maybe::next::method(@_);
-    }
-
-    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->maybe::next::method(@_);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Catalyst::Plugin::Compress - Compress response
-
-=head1 SYNOPSIS
-
-    use Catalyst qw/Compress/;
-
-or
-
-    use Catalyst qw/
-        Unicode
-        Compress
-    /;
-
-If you want to use this plugin with L<Catalyst::Plugin::Unicode>.
-
-Remember to specify compression_format with:
-
-    __PACKAGE__->config(
-        compression_format => $format,
-    );
-
-$format can be either gzip bzip2 zlib or deflate.  bzip2 is B<*only*> supported
-by lynx and some other console text-browsers.
-
-=head1 DESCRIPTION
-
-This module combines L<Catalyst::Plugin::Deflate> L<Catalyst::Plugin::Gzip>
-L<Catalyst::Plugin::Zlib> into one.
-
-It 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
-    /;
-
-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
-

Copied: Catalyst-Plugin-Compress/tags/0.005/lib/Catalyst/Plugin/Compress.pm (from rev 13129, Catalyst-Plugin-Compress/trunk/lib/Catalyst/Plugin/Compress.pm)
===================================================================
--- Catalyst-Plugin-Compress/tags/0.005/lib/Catalyst/Plugin/Compress.pm	                        (rev 0)
+++ Catalyst-Plugin-Compress/tags/0.005/lib/Catalyst/Plugin/Compress.pm	2010-04-06 15:40:51 UTC (rev 13130)
@@ -0,0 +1,191 @@
+package Catalyst::Plugin::Compress;
+
+use strict;
+use Catalyst::Utils;
+use MRO::Compat;
+
+our $VERSION = '0.005';
+
+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"};
+    }
+    if ($c->debug) {
+        $_method
+            ? $c->log->debug(qq{Catalyst::Plugin::Compress sets compression_format to '$_method'})
+            : $c->log->debug(qq{Catalyst::Plugin::Compress has no compression_format config - disabled.});
+    }
+    $c->maybe::next::method(@_);
+}
+
+use List::Util qw(first);
+sub should_compress_response {
+    my ($self) = @_;
+    my ($ct) = split /;/, $self->res->content_type;
+    my @compress_types = qw(
+        application/javascript
+        application/json
+        application/x-javascript
+        application/xml
+    );
+    return 1
+        if ($ct =~ m{^text/})
+            or ($ct =~ m{\+xml$}
+            or (first { lc($ct) eq $_ } @compress_types));
+}
+
+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 (not $c->should_compress_response)
+    ) {
+        return $c->maybe::next::method(@_);
+    }
+
+    my $accept = $c->request->header('Accept-Encoding') || '';
+
+    unless (index($accept, $_method) >= 0) {
+        return $c->maybe::next::method(@_);
+    }
+
+    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->maybe::next::method(@_);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Catalyst::Plugin::Compress - Compress response
+
+=head1 SYNOPSIS
+
+    use Catalyst qw/Compress/;
+
+or
+
+    use Catalyst qw/
+        Unicode
+        Compress
+    /;
+
+If you want to use this plugin with L<Catalyst::Plugin::Unicode>.
+
+Remember to specify compression_format with:
+
+    __PACKAGE__->config(
+        compression_format => $format,
+    );
+
+$format can be either gzip bzip2 zlib or deflate.  bzip2 is B<*only*> supported
+by lynx and some other console text-browsers.
+
+=head1 DESCRIPTION
+
+This module combines L<Catalyst::Plugin::Deflate> L<Catalyst::Plugin::Gzip>
+L<Catalyst::Plugin::Zlib> into one.
+
+It 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
+    /;
+
+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 INTERNAL METHODS
+
+=head2 should_compress_response
+
+This method determine wether compressing the reponse using this plugin.
+
+=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
+




More information about the Catalyst-commits mailing list