On-the-Fly Compression

package Apache::GZipCompress;

use strict vars;
use Apache::Constants ':common';
use Compress::Zlib;
use Apache::File;
use constant GZIP_MAGIC => 0x1f8b;
use constant OS_MAGIC => 0x03;

sub handler {
    my $r = shift;
    my ($fh,$gz);
    my $file = $r->filename;
    $file =~ s/\.gz$//;  # get rid of any .gz ending
    return DECLINED unless $fh=Apache::File->new($file);
    $r->header_out('Content-Encoding'=>'gzip');
    $r->send_http_header;
    return OK if $r->header_only;

    tie *STDOUT,__PACKAGE__,$r;
    print($_) while <$fh>;
    untie *STDOUT;
    return OK;
}

sub TIEHANDLE {
    my($class,$r) = @_;
    my $d = deflateInit(-WindowBits=>-MAX_WBITS()) || return undef;
    $r->print(pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,OS_MAGIC));
    return bless { r   => $r,
		   crc =>  crc32(undef),
		   d   => $d,
	           l   =>  0 
		   },$class;
}

sub PRINT {
    my $self = shift;
    foreach (@_) {
	my $data = $self->{d}->deflate($_);
	$self->{l} += length($_);
	$self->{crc} = crc32($_,$self->{crc});
	$self->{r}->print($data);
    }
}

sub DESTROY {
   my $self = shift;
    my $data = $self->{d}->flush;
    $self->{r}->print($data);
    $self->{r}->print(pack("LL",@{$self}{qw/crc l/}));
}

1;