Added method to clear the buffer and fixed the gzip problem

Also made the default error handlers clear the buffer, to remove
any unneeded output that may have been added by other handlers.

Gzip compression can be enabled and disabled at any time, just
keep in mind that any output before the call will be deleted.

2 files changed, 36 insertions, 40 deletions

diff --git a/lib/YAWF.pm b/lib/YAWF.pm
index ae8604c..f9f6040 100644
--- a/lib/YAWF.pm
+++ b/lib/YAWF.pm
@@ -200,6 +200,7 @@ package YAWF::DefaultHandlers;
 # these are defaults, you really want to replace these boring pages
 sub error_404 {
   my $s = shift;
+  $s->resBuffer(undef);
   $s->resStatus(404);
   very_simple_page($s, '404 - Page Not Found', 'The page you were looking for does not exist...');
 }
@@ -208,6 +209,7 @@ sub error_404 {
 # a *very* helpful error message :-)
 sub error_500 {
   my $s = shift;
+  $s->resBuffer(undef);
   $s->resStatus(500);
   very_simple_page($s, '500 - Internal Server Error', 'Ooooopsie~, something went wrong!');
 }
diff --git a/lib/YAWF/Response.pm b/lib/YAWF/Response.pm
index 0dde132..6c46442 100644
--- a/lib/YAWF/Response.pm
+++ b/lib/YAWF/Response.pm
@@ -8,7 +8,7 @@ use Exporter 'import';
 
 
 our @EXPORT = qw|
-  resInit resHeader resFd resStatus resRedirect resFinish
+  resInit resHeader resBuffer resFd resStatus resRedirect resFinish
 |;
 
 
@@ -27,8 +27,8 @@ sub resInit {
   open $self->{_YAWF}{Res}{fd}, '>:utf8', \$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, though it's possible to
-  #  disable the gzip compression layer later on via resCompress)
+  # (we don't check for browser support or even content, but it's possible to
+  #  disable the gzip compression layer later on via resBuffer)
   eval { require PerlIO::gzip; };
   if(!$@) {
     binmode $self->{_YAWF}{Res}{fd}, ':gzip';
@@ -76,6 +76,37 @@ 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
+# Enabling compression if PerlIO::gzip isn't installed will result in an error
+sub resBuffer {
+  my $self = shift;
+  my $i = $self->{_YAWF}{Res};
+  my $h = $self->resHeader('Content-Encoding');
+  $h = $h && $h eq 'gzip';
+
+  if(@_) {
+    # clear buffer
+    close $i->{fd};
+    $i->{content} = '';
+    open $i->{fd}, '>:utf8', \$i->{content};
+
+    if(!defined $_[0] && $h || $_[0]) {
+      binmode $i->{fd}, ':gzip';
+      $self->resHeader('Content-Encoding', 'gzip');
+    } else {
+      $self->resHeader('Content-Encoding', undef);
+    }
+  }
+
+  $h = $self->resHeader('Content-Encoding');
+  return $h && $h eq 'gzip';
+}
+
+
 # Returns the file descriptor where output functions can 'print' to
 sub resFd {
   return shift->{_YAWF}{Res}{fd};
@@ -124,40 +155,3 @@ sub resFinish {
 1;
 
 
-
-__END__
-
-
-
-# Returns whether output compression is enabled or not with no arguments,
-# Enables or disables compression with argument
-# Enabling compression if PerlIO::gzip isn't installed will result in an error
-# This setting can't be changed after something has been written to the buffer
-
-# Forget it... this idea isn't going to work. The :gzip layer will add a gzip 
-# header as soon as it's activated... so disabling the layer afterwards isn't
-# really going to help as the header is still there
-
-# ...time to think of an alternative solution
-
-sub resCompress {
-  my $self = shift;
-  my $h = $self->resHeader('Content-Encoding');
-  $h = $h && $h eq 'gzip';
-
-  if(@_) {
-    if($h && !$_[0]) {
-      binmode $self->{_YAWF}{Res}{fd}, ':pop';
-      $self->resHeader('Content-Encoding', undef);
-    }
-    elsif(!$h && $_[0]) {
-      binmode $self->{_YAWF}{Res}{fd}, ':gzip';
-      $self->resHeader('Content-Encoding', 'gzip');
-    }
-  }
-
-  $h = $self->resHeader('Content-Encoding');
-  return $h && $h eq 'gzip';
-}
-
-