We are generating possibly large HTML pages (60-150kB) with embperl.
The pages benefit tremendously by compressing them on the fly
(resulting in 2-4 kb transfer size) and this is how its done (its
working since yesterday):
- if you are modifiying headers in the embperl code (eg. late
redirection) you can't use Apache::OutputChain and Apache::GzipChain
since the headers are already out before the content is generated
- so you should use Ken's Apache::Filter (v1.005 from CPAN) which is
more clever. It caches the whole page and gives you a chance to modify
headers while you are generating the page. (Hey Ken, leave the caching
for now :)
- So I took Apache::EmbperlFilter from Mike Schout <[EMAIL PROTECTED]> and
rewrote Apache::GzipChain a little to adapt to Apache::Filter
- You *need* a second filter after the Embperl Filter to have a chance
of modifying headers because Apache::Filter sends headers after using
$r->filter_input;
- In httpd.conf you have
PerlModule Apache::Filter
<FilesMatch "*.html">
SetHandler perl-script
Options ExecCGI
PerlSetVar Filter On
PerlHandler Apache::EmbperlFilter Apache::GzipFilter
</FilesMatch>
Apache-EmbperlFiler.pm from Mike:
-------------------------------------------------------------
package Apache::EmbperlFilter;
use Apache::Util qw(parsedate);
use HTML::Embperl;
use Apache::Constants;
use strict;
use vars qw($VERSION);
$VERSION = '0.03lu';
my ($r, %param, $input, $output);
sub handler {
$r = shift;
my ($fh, $status) = $r->filter_input();
unless ($status == OK) {
return $status
}
$r->deterministic(0); # added this but does it mean that embperl
local $/ = undef; # compiles every time???
$input = scalar(<$fh>);
$param{input} = \$input;
$param{req_rec} = $r;
$param{output} = \$output;
$param{mtime} = mtime();
$param{inputfile} = $r->filename; # added this
$/ = "\n"; # Hey Mike you need this!
HTML::Embperl::ScanEnvironement(\%param);
HTML::Embperl::Execute(\%param);
print $output;
return OK;
}
sub mtime {
my $mtime = undef;
if (my $last_modified = $r->headers_out->{'Last-Modified'}) {
$mtime = parsedate $last_modified;
}
$mtime;
}
1;
--------------------------------------------------------------
and Apache-GzipFilter.pm (borrowed from Andreas Koenig from
Apache::GzipChain):
--------------------------------------------------------------
package Apache::GzipFilter;
use Apache::Constants;
use strict;
use vars qw($VERSION);
$VERSION = '0.01lu';
my ($r, %param, $input, $output);
sub handler {
$r = shift;
my $can_gzip;
my @vary = $r->header_out('Vary') if $r->header_out('Vary');
push @vary, "Accept-Encoding", "User-Agent";
$r->header_out('Vary',
join ", ",
@vary
);
my($accept_encoding) = $r->header_in("Accept-Encoding");
$can_gzip = 1 if index($accept_encoding, 'gzip') >= 0;
unless ($can_gzip) {
my $user_agent = $r->header_in("User-Agent");
if ($user_agent =~ m{
^Mozilla/
\d+
\.
\d+
[\s\[\]\w\-]+
(
\(X11 |
Macint.+PPC,\sNav
)
}x
) {
$can_gzip = 1;
}
}
$r->header_out('Content-Encoding', 'gzip')
if $can_gzip;
my ($fh, $status) = $r->filter_input();
return $status unless $status == OK;
local $/ = undef;
while (<$fh>) {
if ($can_gzip) {
print Compress::Zlib::memGzip($_);
} else {
print;
}
}
return OK;
}
1;
---------------------------------------------------------------------
Have fun,
Dirk
