On-the-Fly Compression

 package Apache::GZip;
 #File: Apache/GZip.pm
 
 use strict vars;
 use Apache::Constants ':common';
 use Compress::Zlib;
 use IO::File;
 use constant GZIP_MAGIC => 0x1f8b;
 use constant OS_MAGIC => 0x03;
 
 sub handler {
     my $r = shift;
     my ($fh,$gz);
     my $file = $r->filename;
     return DECLINED unless $fh=IO::File->new($file);
     $r->header_out('Content-Encoding'=>'gzip');
     $r->send_http_header;
     return OK if $r->header_only;
 
     tie *STDOUT,'Apache::GZip',$r;
     print($_) while <$fh>;
     untie *STDOUT;
     return OK;
 }
 
 sub TIEHANDLE {
     my($class,$r) = @_;
     # initialize a deflation stream
     my $d = deflateInit(-WindowBits=>-MAX_WBITS()) || return undef;

     # gzip header -- don't ask how I found out
     $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 (@_) {
	# deflate the data
 	my $data = $self->{d}->deflate($_);
 	$self->{r}->print($data);
	# keep track of its length and crc
 	$self->{l} += length($_);
 	$self->{crc} = crc32($_,$self->{crc});
     }
 }
 
 sub DESTROY {
    my $self = shift;

    # flush the output buffers
    my $data = $self->{d}->flush;
    $self->{r}->print($data);
    
    # print the CRC and the total length (uncompressed)
    $self->{r}->print(pack("LL",@{$self}{qw/crc l/}));
 }
 
 1;