summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2009-07-05 20:19:12 +0200
committerYorhel <git@yorhel.nl>2009-07-05 20:23:32 +0200
commitbbaa71111293bdb12bdae178157e49a846af7b7f (patch)
treee6b860e1990cf95494ca3ed1414f77578df5551a
parent7e659f8b434533799f2dd0fc0a3f03c0e8cab9ba (diff)
Improved output compression feature
The output compression used can be configured with a content_encoding option to YAWF::init, and the arguments to resBuffer has been updated to reflect the deflate compression and autodetection support.
-rw-r--r--lib/YAWF/Response.pm61
1 files changed, 35 insertions, 26 deletions
diff --git a/lib/YAWF/Response.pm b/lib/YAWF/Response.pm
index 5bcc126..d0172d8 100644
--- a/lib/YAWF/Response.pm
+++ b/lib/YAWF/Response.pm
@@ -27,17 +27,11 @@ sub resInit {
content => '',
};
- open $self->{_YAWF}{Res}{fd}, '>', \$self->{_YAWF}{Res}{content};
-
- # enable output compression by default if the PerlIO::gzip module is available
- # (we don't check for browser support or even content, but it's possible to
- # disable the gzip compression layer later on via resBuffer)
+ # try to load PerlIO::gzip, resBuffer will check for its availability
eval { require PerlIO::gzip; };
- if(!$@) {
- binmode $self->{_YAWF}{Res}{fd}, ':gzip';
- $self->resHeader('Content-Encoding' => 'gzip');
- }
- binmode $self->{_YAWF}{Res}{fd}, ':utf8';
+
+ # open output buffer
+ $self->resBuffer($self->{_YAWF}{content_encoding}||'auto');
}
@@ -79,35 +73,50 @@ sub resHeader {
}
-# Argument Action
-# none Returns whether gzip compression is enabled or not
-# undef Clears the internal buffer
-# 0 Clears buffer and disables gzip
-# 1 Clears and enables gzip
+# Argument Action
+# none/empty Returns output compression type: none/gzip/deflate
+# 'clear' Clears the internal buffer, but doesn't change compression method
+# 'none' Clears buffer and disables output compression
+# 'gzip' Clears and enables gzip
+# 'deflate' Clears and enables deflate
+# 'auto' Clears and autodetects output compression from request header
# Enabling compression if PerlIO::gzip isn't installed will result in an error
sub resBuffer {
my $self = shift;
+ my $act = shift;
my $i = $self->{_YAWF}{Res};
+
my $h = $self->resHeader('Content-Encoding');
- $h = $h && $h eq 'gzip';
+ $h = !$h ? 'none' : $h eq 'gzip' ? 'gzip' : $h eq 'deflate' ? 'deflate' : 'none';
+
+ if($act) {
+ my $new = $act eq 'clear' ? $h : $act;
+ if($new eq 'auto') {
+ # can we even do output compression?
+ if(!defined $PerlIO::gzip::VERSION) {
+ $new = 'none';
+ }
+ # seems like we can, figure out which encoding to use
+ else {
+ my $enc = $self->reqHeader('Accept-Encoding')||'';
+ my $gzip = $enc !~ /gzip\s*(?:;\s*q=(\d+(?:\.\d*)?))?/ ? 0 : defined $1 ? $1 : 1;
+ my $deflate = $enc !~ /deflate\s*(?:;\s*q=(\d+(?:\.\d*)?))?/ ? 0 : defined $1 ? $1 : 1;
+ $new = !$gzip && !$deflate ? 'none' : $deflate > $gzip ? 'deflate' : 'gzip';
+ }
+ }
- if(@_) {
# clear buffer
- close $i->{fd};
+ close $i->{fd} if defined $i->{fd};
$i->{content} = '';
open $i->{fd}, '>', \$i->{content};
- if(!defined $_[0] && $h || $_[0]) {
- binmode $i->{fd}, ':gzip';
- $self->resHeader('Content-Encoding', 'gzip');
- } else {
- $self->resHeader('Content-Encoding', undef);
- }
+ # set output compression
+ binmode $i->{fd}, $new eq 'gzip' ? ':gzip' : ':gzip(none)' if $new ne 'none';
binmode $i->{fd}, ':utf8';
+ $self->resHeader('Content-Encoding', $new eq 'none' ? undef : $new);
}
- $h = $self->resHeader('Content-Encoding');
- return $h && $h eq 'gzip';
+ return $h;
}