@@ -1,32 +0,0 @@
-Revision history for Perl extension Apache::Clean for mod_perl 2.0.
-
-2.00b 10.14.2002
- - original port to mod_perl 2.0
-
-2.01b 03.04.2003
- - major updates based on newfound knowledge
- - mega kudos to Stas for taking the time
- to work, listen, question, and answer
-
-2.02b 03.07.2003
- - fix Makefile.PL to install relative to Apache2 if required
-
-2.00_3 03.18.2003
- - change VERSION scheme to signify beta to CPAN
- - fix TEST.PL so that it includes Apache2.pm
- - fix Makefile.PL - no need to check for Apache::Test
- with a pure mod_perl 2.0 module (duh)
- - add call to Apache::TestMM::filter_args()
-
-2.00_4 05.29.2003
- - updates based on lots and lots of newfound knowledge
- also syncs with perl.com article
-
-2.00_5 02.01.2005
- - adjust t/05mod_cgi.t to create files relative to t/
-
-2.00_6 04.12.2005
- - update for mod_perl 2.0-RC5 (1.999_22)
-
-2.00_7 04.14.2005
- - fix pod so it matches the distribution
@@ -1,96 +1,203 @@
package Apache::Clean;
-use 5.008;
+#---------------------------------------------------------------------
+# usage: PerlHandler Apache::Clean
+#
+# see the Apache::Clean manpage or POD at the end of this file
+#
+# $Id: Clean.pm,v 1.12 2002/07/02 18:51:52 geoff Exp $
+#---------------------------------------------------------------------
+
+use 5.004;
+use mod_perl 1.21;
+use Apache::Constants qw( OK DECLINED );
+use Apache;
+use Apache::File;
+use Apache::Log;
+use HTML::Clean;
+use strict;
-use Apache2::Filter (); # $f
-use Apache2::RequestRec (); # $r
-use Apache2::RequestUtil (); # $r->dir_config()
-use Apache2::Log (); # $log->info()
-use APR::Table (); # dir_config->get() and headers_out->get()
+$Apache::Clean::VERSION = '0.05';
-use Apache2::Const -compile => qw(OK DECLINED);
+# set debug level
+# 0 - messages at info or debug log levels
+# 1 - verbose output at info or debug log levels
+$Apache::Clean::DEBUG = 0;
-use HTML::Clean ();
+# Get the package modification time...
+(my $package = __PACKAGE__) =~ s!::!/!g;
+my $package_mtime = (stat $INC{"$package.pm"})[9];
-use strict;
+# ...and when httpd.conf was last modified
+my $conf_mtime = (stat Apache->server_root_relative('conf/httpd.conf'))[9];
-our $VERSION = '2.00_7';
+# When the server is restarted we need to
+# make sure we recognize config file changes and propigate
+# them to the client to clear the client cache if necessary.
+Apache->server->register_cleanup(sub {
+ $conf_mtime = (stat Apache->server_root_relative('conf/httpd.conf'))[9];
+});
sub handler {
+#---------------------------------------------------------------------
+# initialize request object and variables
+#---------------------------------------------------------------------
- my $f = shift;
+ my $r = shift;
- my $r = $f->r;
+ my $filter = lc $r->dir_config('Filter') eq 'on';
- my $log = $r->server->log;
+ # Register ourselves with Apache::Filter so
+ # later filters can see our output.
+ $r = $r->filter_register if $filter;
- # we only process HTML documents
- unless ($r->content_type =~ m!text/html!i) {
- $log->info('skipping request to ', $r->uri, ' (not an HTML document)');
+ my $log = $r->server->log;
- return Apache2::Const::DECLINED;
- }
+ my ($fh, $cache) = ();
+
+#---------------------------------------------------------------------
+# do some preliminary stuff...
+#---------------------------------------------------------------------
+
+ $log->info("Using Apache::Clean");
- my $context;
+ # we need separate content-type checks for filtered
+ # unfiltered cases. in the unfiltered case we can decline sooner...
+ unless ($r->content_type =~ m!text/html!i || $filter) {
+ $log->info("\trequest is not for an html document ",
+ "(unfiltered request) - skipping...")
+ if $Apache::Clean::DEBUG;
+ $log->info("Exiting Apache::Clean");
- unless ($f->ctx) {
- # these are things we only want to do once no matter how
- # many times our filter is invoked per request
+ return DECLINED;
+ }
+
+#---------------------------------------------------------------------
+# get the filehandle
+#---------------------------------------------------------------------
- # parse the configuration options
- my $level = $r->dir_config->get('CleanLevel') || 1;
+ if ($filter) {
- my %options = map { $_ => 1 } $r->dir_config->get('CleanOption');
+ $log->info("\tgetting request input from Apache::Filter")
+ if $Apache::Clean::DEBUG;
- # store the configuration
- $context = { level => $level,
- options => \%options,
- extra => undef };
+ # Get any output from previous filters in the chain.
+ ($fh, my $status) = $r->filter_input;
- # output filters that alter content are responsible for removing
- # the Content-Length header, but we only need to do this once.
- $r->headers_out->unset('Content-Length');
+ unless ($status == OK) {
+ $log->warn("\tApache::Filter returned $status");
+ $log->info("Exiting Apache::Clean");
+
+ return $status;
+ }
}
+ else {
- # retrieve the filter context, which was set up on the first invocation
- $context ||= $f->ctx;
+ $log->info("\tgetting request input from Apache::File")
+ if $Apache::Clean::DEBUG;
- # now, filter the content
- while ($f->read(my $buffer, 1024)) {
+ # We are not part of a filter chain, so just process as normal.
+ $fh = Apache::File->new($r->filename);
- # prepend any tags leftover from the last buffer or invocation
- $buffer = $context->{extra} . $buffer if $context->{extra};
+ unless ($fh) {
+ $log->warn("\tcannot open request! $!");
+ $log->info("Exiting Apache::Clean");
+
+ return DECLINED;
+ }
- # if our buffer ends in a split tag ('<strong' for example)
- # save processing the tag for later
- if (($context->{extra}) = $buffer =~ m/(<[^>]*)$/) {
- $buffer = substr($buffer, 0, - length($context->{extra}));
+ # since we're essentially sending a static file
+ # we can set cache headers properly based on the
+ # file itself - although we're modifying the
+ # content the meaning of the content doesn't
+ # change unless it:
+ # changes on disk
+ # this package is modified
+ # our httpd.conf options have changed
+
+ # however, in the interests of back compatibility, make
+ # proper cache behavior an option
+ $cache = lc $r->dir_config('CleanCache') || 'on';
+
+ if ($cache eq 'on') {
+ # set what we can from here, more later...
+ $r->update_mtime($package_mtime);
+ $r->update_mtime((stat $r->finfo)[9]);
+ $r->update_mtime($conf_mtime);
+ $r->set_last_modified;
+ $r->set_etag;
}
+ }
+
+ # special decline case for Apache::Filter
+ # here, we need to send the content onward even though
+ # we don't process it. this is to make sure that the
+ # next filter (either a PerlHandler or the browser) gets
+ # the content
- my $h = HTML::Clean->new(\$buffer);
+ if ($r->content_type !~ m!text/html!i && $filter) {
+ $log->info("\trequest is not for an html document ",
+ "(Apache::Filter) - skipping...")
+ if $Apache::Clean::DEBUG;
- $h->level($context->{level});
+ $r->send_http_header($r->content_type);
+ print while <$fh>;
- $h->strip($context->{options});
+ $log->info("Exiting Apache::Clean");
- $f->print(${$h->data});
+ # we can't ever return DECLINED when using Apache::Filter
+ return OK;
}
- if ($f->seen_eos) {
- # we've seen the end of the data stream
+#---------------------------------------------------------------------
+# clean up the html
+#---------------------------------------------------------------------
+
+ # Slurp the file.
+ my $dirty = do { local $/; <$fh> };
+
+ # Create the new HTML::Clean object.
+ my $h = HTML::Clean->new(\$dirty);
+
+ # Set the level of suds.
+ $h->level($r->dir_config('CleanLevel') || 1);
+
+ my %options = map { $_ => 1 } $r->dir_config->get('CleanOption');
+
+ # clean the HTML
+ $h->strip(\%options);
+
+#---------------------------------------------------------------------
+# print the clean results
+#---------------------------------------------------------------------
+
+ if ($cache eq 'on') {
+ # we needed to clean the data first before we
+ # could find the length
+ $r->set_content_length(length ${$h->data});
- # print any leftover data
- $f->print($context->{extra}) if $context->{extra};
+ # only send the file if it meets cache criteria
+ if ((my $status = $r->meets_conditions) == OK) {
+ $r->send_http_header($r->content_type);
+ }
+ else {
+ return $status;
+ }
}
else {
- # there's more data to come
-
- # store the filter context, including any leftover data
- # in the 'extra' key
- $f->ctx($context);
+ # else we just send a header
+ $r->send_http_header($r->content_type);
}
- return Apache2::Const::OK;
+ print ${$h->data};
+
+#---------------------------------------------------------------------
+# wrap up...
+#---------------------------------------------------------------------
+
+ $log->info("Exiting Apache::Clean");
+
+ return OK;
}
1;
@@ -99,37 +206,47 @@ __END__
=head1 NAME
-Apache::Clean - interface into HTML::Clean for mod_perl 2.0
+Apache::Clean - mod_perl interface into HTML::Clean
=head1 SYNOPSIS
httpd.conf:
- PerlModule Apache::Clean
+ PerlModule Apache::Clean
+
+ <Location /clean>
+ SetHandler perl-script
+ PerlHandler Apache::Clean
+
+ PerlSetVar CleanLevel 3
+
+ PerlSetVar CleanOption shortertags
+ PerlAddVar CleanOption whitespace
+
+ PerlSetVar CleanCache On
+ </Location>
- Alias /clean /usr/local/apache2/htdocs
- <Location /clean>
- PerlOutputFilterHandler Apache::Clean
+Apache::Clean is Filter aware, meaning that it can be used within
+Apache::Filter framework without modification. Just include the
+directives
- PerlSetVar CleanOption shortertags
- PerlAddVar CleanOption whitespace
- </Location>
+ PerlModule Apache::Filter
+ PerlSetVar Filter On
+
+and modify the PerlHandler directive accordingly...
=head1 DESCRIPTION
Apache::Clean uses HTML::Clean to tidy up large, messy HTML, saving
-bandwidth.
+bandwidth. It is particularly useful with Apache::Compress for
+ultimate savings.
Only documents with a content type of "text/html" are affected - all
others are passed through unaltered.
-For more information, see
-
- http://www.perl.com/pub/a/2003/04/17/filters.html
-
=head1 OPTIONS
-Apache::Clean supports few options - all of which are based on
+Apache::Clean supports few options, most of which are based on
options from HTML::Clean. Apache::Clean will only tidy up whitespace
(via $h->strip) and will not perform other options of HTML::Clean
(such as browser compatibility). See the HTML::Clean manpage for
@@ -144,41 +261,72 @@ in HTML::Clean.
PerlSetVar CleanLevel 9
-CleanLevel defaults to 1.
+CleanLevel defaults to 3.
=item CleanOption
specifies the set of options which are passed to the options()
-method in HTML::Clean - see the HTML::Clean manpage for a complete
-list of options.
+method in HTML::Clean.
+
+ PerlAddVar CleanOption shortertags
+ PerlSetVar CleanOption whitespace
+
+CleanOption has do default.
- PerlSetVar CleanOption shortertags
- PerlAddVar CleanOption whitespace
+=item CleanCache
-CleanOption has no default.
+sets the behavior of Apache::Clean in regards to proper
+cache header behavior. this option is only meaningful
+when Apache::Clean is _not_ part of an Apache::Filter
+chain.
+
+mainly, CleanCache On enables Apache::Clean to
+set the Last-Modified, Content-Length, and Etag headers,
+as well as allowing it do decide whether a 304 response
+is allowed. See recipe 6.6 in the mod_perl Developer's
+Cookbook for a more detailed discussion on handling
+conditional and cache-based headers - the code is
+practically identical to what you will find there.
+
+The basic idea here is that although Apache::Clean is
+dynamically manipulating the content of the requested
+resource, the meaning of the document has not changed
+just because <strong> was changed to <b>. If you
+disagree with this assessment you can set CleanCache to
+Off.
+
+CleanCache defaults to On.
=back
=head1 NOTES
+Verbose debugging is enabled by setting $Apache::Clean::DEBUG=1
+or greater. To turn off all debug information, set your apache
+LogLevel directive above info level.
+
This is alpha software, and as such has not been tested on multiple
-platforms or environments.
+platforms or environments. It requires PERL_LOG_API=1,
+PERL_FILE_API=1, and maybe other hooks to function properly.
=head1 FEATURES/BUGS
-probably lots - this is the preliminary port to mod_perl 2.0
+No known bugs or features at this time...
=head1 SEE ALSO
-perl(1), mod_perl(3), Apache(3), HTML::Clean(3)
+perl(1), mod_perl(3), Apache(3), HTML::Clean(3), Apache::Compress(3),
+Apache::Filter(3)
-=head1 AUTHOR
+=head1 AUTHORS
Geoffrey Young <geoff@modperlcookbook.org>
+Paul Lindner <paul@modperlcookbook.org>
+Randy Kobes <randy@modperlcookbook.org>
=head1 COPYRIGHT
-Copyright (c) 2005, Geoffrey Young
+Copyright (c) 2002, Geoffrey Young, Paul Lindner, Randy Kobes.
All rights reserved.
This module is free software. It may be used, redistributed
@@ -1,37 +0,0 @@
-INSTALLATION:
-
-this module follows the standard
-
- $ perl Makefile.PL
- $ make
- $ su
- # make install
-
-routine.
-
-if you want to run the tests, you'll need to do
-something similar to the following
-
- $ export APACHE=/usr/local/apache2/bin/httpd
- $ export APXS=/usr/local/apache2/bin/apxs
- $ make test
-
-whether you choose to specify httpd or apxs depends on
-whether or not your installation is has mod_so, so you may need
-one or the other or both.
-
-you can also configure the test suite when building the Makefile
-
- $ perl Makefile.PL -apxs /usr/local/apache2/bin/apxs
-
-run
-
- $ t/TEST -help
-
-or see the README in the Apache::Test distribtion for more options
-
-of course, this module is made to run under Apache 2.0
-and mod_perl 2.0 so you'll need those as well. perl 5.8.0
-is also a good idea.
-
-have fun.
@@ -1,29 +1,16 @@
-Changes
-Clean.pm
-INSTALL
Makefile.PL
-MANIFEST This list of files
+MANIFEST
README
-t/01level.t
-t/02option.t
-t/03cl.t
-t/04plain.t
-t/05dynamic.t
-t/06mod_cgi.t
-t/07registry.t
-t/08notfound.t
-t/09long.t
-t/10extra.t
-t/11decline.t
-t/99pod.t
+Clean.pm
+t/TEST.PL
t/conf/extra.conf.in
+t/conf/modperl_extra.pl
t/htdocs/index.html
t/htdocs/index.txt
-t/My/DynamicHTML.pm
-t/My/Extra.pm
-t/My/Long.pm
-t/My/PlainHandler.pm
-t/My/Uppercase.pm
-t/perl-bin/include.pl
-t/perl-bin/plain.pl
-META.yml Module meta-data (added by MakeMaker)
+t/01basic.t
+t/02hooks.t
+t/03level.t
+t/04option.t
+t/05filter.t
+t/06cache.t
+t/07plain.t
@@ -1,12 +0,0 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Apache-Clean
-version: 2.00_7
-version_from: Clean.pm
-installdirs: site
-requires:
- HTML::Clean: 0.8
- mod_perl2: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
@@ -1,21 +1,26 @@
#!perl
-use 5.008;
+use ExtUtils::MakeMaker;
-use ModPerl::MM ();
-use Apache::TestMM qw(test clean);
-use Apache::TestRunPerl ();
-
-# configure tests based on incoming arguments
-Apache::TestMM::filter_args();
+WriteMakefile(
+ 'NAME' => 'Apache::Clean',
+ 'VERSION_FROM' => 'Clean.pm', # finds $VERSION
+ 'PREREQ_PM' => { HTML::Clean => 0.08,
+ mod_perl => 1.21, },
+);
-# provide the test harness
-Apache::TestRunPerl->generate_script();
+sub MY::test {
+ if (eval "require Apache::TestMM") {
+ Apache::TestMM::generate_script('t/TEST');
+ Apache::TestMM->import(qw(test clean));
+ return Apache::TestMM->test;
+ }
-# now, write out the Makefile
-ModPerl::MM::WriteMakefile(
- NAME => 'Apache::Clean',
- VERSION_FROM => 'Clean.pm',
- PREREQ_PM => { HTML::Clean => 0.8,
- mod_perl2 => 0, },
-);
+ # The whitespace in front of @echo MUST be a single tab!
+ return <<'EOF';
+test::
+ @echo This test suite requires Apache::Test
+ @echo available from the mod_perl 2.0 sources
+ @echo or the httpd-test distribution.
+EOF
+}
@@ -1,190 +1,128 @@
-package Apache::Clean;
+NAME
-use 5.008;
+Apache::Clean - mod_perl interface into HTML::Clean
-use Apache2::Filter (); # $f
-use Apache2::RequestRec (); # $r
-use Apache2::RequestUtil (); # $r->dir_config()
-use Apache2::Log (); # $log->info()
-use APR::Table (); # dir_config->get() and headers_out->get()
+SYNOPSIS
-use Apache2::Const -compile => qw(OK DECLINED);
-
-use HTML::Clean ();
-
-use strict;
-
-our $VERSION = '2.00_6';
-
-sub handler {
-
- my $f = shift;
-
- my $r = $f->r;
-
- my $log = $r->server->log;
-
- # we only process HTML documents
- unless ($r->content_type =~ m!text/html!i) {
- $log->info('skipping request to ', $r->uri, ' (not an HTML document)');
-
- return Apache2::Const::DECLINED;
- }
-
- my $context;
-
- unless ($f->ctx) {
- # these are things we only want to do once no matter how
- # many times our filter is invoked per request
-
- # parse the configuration options
- my $level = $r->dir_config->get('CleanLevel') || 1;
-
- my %options = map { $_ => 1 } $r->dir_config->get('CleanOption');
-
- # store the configuration
- $context = { level => $level,
- options => \%options,
- extra => undef };
-
- # output filters that alter content are responsible for removing
- # the Content-Length header, but we only need to do this once.
- $r->headers_out->unset('Content-Length');
- }
-
- # retrieve the filter context, which was set up on the first invocation
- $context ||= $f->ctx;
-
- # now, filter the content
- while ($f->read(my $buffer, 1024)) {
-
- # prepend any tags leftover from the last buffer or invocation
- $buffer = $context->{extra} . $buffer if $context->{extra};
-
- # if our buffer ends in a split tag ('<strong' for example)
- # save processing the tag for later
- if (($context->{extra}) = $buffer =~ m/(<[^>]*)$/) {
- $buffer = substr($buffer, 0, - length($context->{extra}));
- }
-
- my $h = HTML::Clean->new(\$buffer);
-
- $h->level($context->{level});
-
- $h->strip($context->{options});
-
- $f->print(${$h->data});
- }
-
- if ($f->seen_eos) {
- # we've seen the end of the data stream
-
- # print any leftover data
- $f->print($context->{extra}) if $context->{extra};
- }
- else {
- # there's more data to come
-
- # store the filter context, including any leftover data
- # in the 'extra' key
- $f->ctx($context);
- }
-
- return Apache2::Const::OK;
-}
+httpd.conf:
-1;
-
-__END__
+ PerlModule Apache::Clean
-=head1 NAME
+ <Location /clean>
+ SetHandler perl-script
+ PerlHandler Apache::Clean
-Apache::Clean - interface into HTML::Clean for mod_perl 2.0
+ PerlSetVar CleanLevel 3
-=head1 SYNOPSIS
+ PerlSetVar CleanOption shortertags
+ PerlAddVar CleanOption whitespace
-httpd.conf:
+ PerlSetVar CleanCache On
+ </Location>
- PerlModule Apache::Clean
+Apache::Clean is Filter aware, meaning that it can be used within
+Apache::Filter framework without modification. Just include the
+directives
- Alias /clean /usr/local/apache2/htdocs
- <Location /clean>
- PerlOutputFilterHandler Apache::Clean
+ PerlModule Apache::Filter
+ PerlSetVar Filter On
- PerlSetVar CleanOption shortertags
- PerlAddVar CleanOption whitespace
- </Location>
+and modify the PerlHandler directive accordingly...
-=head1 DESCRIPTION
+DESCRIPTION
Apache::Clean uses HTML::Clean to tidy up large, messy HTML, saving
-bandwidth.
+bandwidth. It is particularly useful with Apache::Compress for
+ultimate savings.
Only documents with a content type of "text/html" are affected - all
others are passed through unaltered.
-For more information, see
-
- http://www.perl.com/pub/a/2003/04/17/filters.html
-
-=head1 OPTIONS
+OPTIONS
-Apache::Clean supports few options - all of which are based on
+Apache::Clean supports few options, most of which are based on
options from HTML::Clean. Apache::Clean will only tidy up whitespace
(via $h->strip) and will not perform other options of HTML::Clean
(such as browser compatibility). See the HTML::Clean manpage for
details.
-=over 4
-
-=item CleanLevel
+CleanLevel
sets the clean level, which is passed to the level() method
in HTML::Clean.
PerlSetVar CleanLevel 9
-CleanLevel defaults to 1.
+CleanLevel defaults to 3.
-=item CleanOption
+CleanOption
specifies the set of options which are passed to the options()
-method in HTML::Clean - see the HTML::Clean manpage for a complete
-list of options.
+method in HTML::Clean.
+
+ PerlAddVar CleanOption shortertags
+ PerlSetVar CleanOption whitespace
+
+CleanOption has do default.
+
+CleanCache
+
+sets the behavior of Apache::Clean in regards to proper
+cache header behavior. this option is only meaningful
+when Apache::Clean is _not_ part of an Apache::Filter
+chain.
+
+mainly, CleanCache On enables Apache::Clean to
+set the Last-Modified, Content-Length, and Etag headers,
+as well as allowing it do decide whether a 304 response
+is allowed. See recipe 6.6 in the mod_perl Developer's
+Cookbook for a more detailed discussion on handling
+conditional and cache-based headers - the code is
+practically identical to what you will find there.
- PerlSetVar CleanOption shortertags
- PerlAddVar CleanOption whitespace
+The basic idea here is that although Apache::Clean is
+dynamically manipulating the content of the requested
+resource, the meaning of the document has not changed
+just because <strong> was changed to <b>. If you
+disagree with this assessment you can set CleanCache to
+Off.
-CleanOption has no default.
+CleanCache defaults to On.
-=back
+NOTES
-=head1 NOTES
+Verbose debugging is enabled by setting $Apache::Clean::DEBUG=1
+or greater. To turn off all debug information, set your apache
+LogLevel directive above info level.
This is alpha software, and as such has not been tested on multiple
-platforms or environments.
+platforms or environments. It requires PERL_LOG_API=1,
+PERL_FILE_API=1, and maybe other hooks to function properly.
-=head1 FEATURES/BUGS
+FEATURES/BUGS
-probably lots - this is the preliminary port to mod_perl 2.0
+No known bugs or features at this time...
-=head1 SEE ALSO
+SEE ALSO
-perl(1), mod_perl(3), Apache(3), HTML::Clean(3)
+perl(1), mod_perl(3), Apache(3), HTML::Clean(3), Apache::Compress(3),
+Apache::Filter(3)
-=head1 AUTHOR
+AUTHORS
Geoffrey Young <geoff@modperlcookbook.org>
+Paul Lindner <paul@modperlcookbook.org>
+Randy Kobes <randy@modperlcookbook.org>
-=head1 COPYRIGHT
+COPYRIGHT
-Copyright (c) 2005, Geoffrey Young
+Copyright (c) 2002, Geoffrey Young, Paul Lindner, Randy Kobes.
All rights reserved.
This module is free software. It may be used, redistributed
and/or modified under the same terms as Perl itself.
-=head1 HISTORY
+HISTORY
This code is derived from the Cookbook::Clean and
Cookbook::TestMe modules available as part of
@@ -192,4 +130,3 @@ Cookbook::TestMe modules available as part of
For more information, visit http://www.modperlcookbook.org/
-=cut
@@ -0,0 +1,14 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+
+plan tests => 3;
+
+ok require 5.005;
+ok require mod_perl;
+ok $mod_perl::VERSION >= 1.21;
+
+# can't do this test anymore as long
+# as we're calling Apache->server_root_relative
+# ok require Apache::Clean;
@@ -1,15 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test qw(plan ok have_lwp);
-use Apache::TestRequest qw(GET);
-use Apache::TestUtil qw(t_cmp);
-
-# test CleanLevel
-
-plan tests => 1, have_lwp;
-
-my $response = GET '/level/index.html';
-chomp(my $content = $response->content);
-
-ok t_cmp(q!<i><b>"This is a test"</b></i>!, $content);
@@ -0,0 +1,9 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+
+plan tests => 1, have_lwp;
+
+ok GET_OK '/hooks';
@@ -1,14 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test;
-use Apache::TestRequest;
-
-# test CleanOption
-
-plan tests => 1, have_lwp;
-
-my $response = GET '/option/index.html';
-chomp(my $content = $response->content);
-
-ok ($content eq q!<i><b>"This is a test"</b></i>!);
@@ -1,17 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test;
-use Apache::TestRequest;
-
-# test Content-Length logic
-
-plan tests => 2, have_lwp;
-
-# plain text is handled my default-handler which sets C-L
-my $response = GET '/level/index.txt';
-ok ($response->content_length == 58);
-
-# html is handled by the filter which removes C-L
-$response = GET '/level/index.html';
-ok (! $response->content_length);
@@ -0,0 +1,11 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+
+plan tests => 1, have_lwp;
+
+my $content = GET_BODY '/level/index.html';
+chomp $content;
+ok ($content eq q!<strong>"This is a test"</strong><i> </i>!);
@@ -0,0 +1,11 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+
+plan tests => 1, have_lwp;
+
+my $content = GET_BODY '/option/index.html';
+chomp $content;
+ok ($content eq q!<b>"This is a test"</b><i> </i>!);
@@ -1,14 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test;
-use Apache::TestRequest;
-
-# make sure that non-HTML documents pass through unaltered
-
-plan tests => 1, have_lwp;
-
-my $response = GET '/level/index.txt';
-chomp(my $content = $response->content);
-
-ok ($content eq q!<i ><strong>"This is a test"</strong></i >!);
@@ -1,23 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test;
-use Apache::TestRequest;
-
-# test dynamically generated content
-
-plan tests => 2, have_lwp;
-
-# dynamic but plain content should be unaltered
-
-my $response = GET '/plain-dynamic';
-chomp(my $content = $response->content);
-
-ok ($content eq q!<i ><strong>"This is a test"</strong></i >!);
-
-# dynamic HTML should get filtered
-
-$response = GET '/html-dynamic';
-chomp($content = $response->content);
-
-ok ($content eq q!<i><b>"This is a test"</b></i>!);
@@ -0,0 +1,22 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+
+plan tests => 3, \&have_filter;
+
+my $response = GET '/filter/index.html';
+my $content = $response->content;
+chomp $content;
+ok $response->code == 200;
+ok ($content eq q!<b>"This is a test"</b><i> </i>!);
+ok (!$response->header('last_modified'));
+
+sub have_filter {
+ eval {
+ die unless have_lwp();
+ require Apache::Filter;
+ };
+ return $@ ? 0 : 1;
+}
@@ -0,0 +1,17 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+
+plan tests => 4, \&have_lwp;
+
+my $response = GET '/option/index.html';
+ok $response->code == 200;
+
+my $rc = system('touch', 'htdocs/index.html') >> 8;
+ok(!$rc);
+
+my $response2 = GET '/option/index.html';
+ok $response->code == 200;
+ok ($response->header('last_modified') ne $response2->header('last_modified'));
@@ -1,46 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test;
-use Apache::TestRequest;
-use Apache::TestUtil qw(t_write_perl_script);
-
-use File::Spec::Functions qw(catfile);
-
-# test mod_cgi + SSI + Apache::Clean
-
-plan tests => 4, (have_lwp &&
- have_cgi &&
- have_module('include'));
-
-# first, generate the CGI scripts with the proper shebang line
-
-my @lines = <DATA>;
-
-my $serverroot = Apache::Test::vars('serverroot');
-
-t_write_perl_script(catfile($serverroot,
- qw(cgi-bin plain.cgi)), @lines[0,2]);
-t_write_perl_script(catfile($serverroot,
- qw(cgi-bin include.cgi)), @lines[1,2]);
-
-# type text/plain should be unaltered
-
-my $response = GET '/cgi-bin/plain.cgi';
-chomp(my $content = $response->content);
-
-ok ($content eq q!<strong>/cgi-bin/plain.cgi</strong>!);
-ok ($response->content_type =~ m!text/plain!);
-
-# type text/html should have shorter tags
-
-$response = GET '/cgi-bin/include.cgi';
-chomp($content = $response->content);
-
-ok ($content eq q!<b>/cgi-bin/include.cgi</b>!);
-ok ($response->content_type =~ m!text/html!);
-
-__END__
-print "Content-Type: text/plain\n\n";
-print "Content-Type: text/html\n\n";
-print '<strong><!--#echo var="DOCUMENT_URI" --></strong>';
@@ -0,0 +1,23 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+
+plan tests => 2, \&have_filter;
+
+my $content = GET_BODY '/plain-dynamic';
+chomp $content;
+ok ($content eq q!This is a plain test!);
+
+$content = GET_BODY '/plain-static/index.txt';
+chomp $content;
+ok ($content eq q!This is a plain test!);
+
+sub have_filter {
+ eval {
+ die unless have_lwp();
+ require Apache::Filter;
+ };
+ return $@ ? 0 : 1;
+}
@@ -1,26 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test;
-use Apache::TestRequest;
-
-# test ModPerl::Registry + SSI + Apache::Clean
-
-plan tests => 4, (have_lwp &&
- have_module('include'));
-
-# type text/plain should be unaltered
-
-my $response = GET '/perl-bin/plain.pl';
-chomp(my $content = $response->content);
-
-ok ($content eq q!<strong>/perl-bin/plain.pl</strong>!);
-ok ($response->content_type =~ m!text/plain!);
-
-# type text/html should have shorter tags
-
-$response = GET '/perl-bin/include.pl';
-chomp($content = $response->content);
-
-ok ($content eq q!<b>/perl-bin/include.pl</b>!);
-ok ($response->content_type =~ m!text/html!);
@@ -1,24 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test;
-use Apache::TestRequest;
-
-# make sure that non-OK codes are handled properly
-
-plan tests => 4, have_lwp;
-
-# 404 is a good enough example to try
-
-my $response = GET '/level/foo.html';
-ok ($response->code == 404);
-
-$response = GET '/level/foo.txt';
-ok ($response->code == 404);
-
-$response = GET '/cgi-bin/foo.cgi';
-ok ($response->code == 404);
-
-$response = GET '/perl-bin/foo.cgi';
-ok ($response->code == 404);
-
@@ -1,43 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test;
-use Apache::TestRequest;
-
-# this is a test to see if our
-# buffer logic works when our filter
-# sends data to HTML::Clean in chunks.
-
-plan tests => 4, have_lwp;
-
-# <strong> is 8 characters long
-# our buffer is 1024 characters
-# so 1016 characters plus <strong> should
-# pass exactly one buffer to our filter
-
-my $response = GET '/long?1016';
-chomp(my $content = $response->content);
-ok($content eq ('x' x 1016) . '<b></b>');
-
-# now the <strong> tag is broken when fed to
-# HTML::Clean - make sure our buffer breaks
-# the line properly so we don't end up
-# with <strong></b>
-
-$response = GET '/long?1017';
-chomp($content = $response->content);
-ok($content eq ('x' x 1017) . '<b></b>');
-
-# the last test was <strong
-# let's test the other end of our regex, just <
-
-$response = GET '/long?1023';
-chomp($content = $response->content);
-ok($content eq ('x' x 1023) . '<b></b>');
-
-# now we're fully into the second buffer
-
-$response = GET '/long?1024';
-chomp($content = $response->content);
-ok($content eq ('x' x 1024) . '<b></b>');
-
@@ -1,16 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test;
-use Apache::TestRequest;
-
-# this tests whether we can properly
-# store broken tags in the filter context
-# if data is sent over multiple filter invocations
-
-plan tests => 1, have_lwp;
-
-my $response = GET '/extra';
-chomp(my $content = $response->content);
-ok($content eq ('x' x 1020) . '</body></html');
-
@@ -1,15 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-
-use Apache::Test;
-use Apache::TestRequest;
-
-# this tests whether action on non-HTML responses
-# allows other filters to still see the data
-
-plan tests => 1, have_lwp;
-
-my $response = GET '/decline';
-chomp(my $content = $response->content);
-
-ok ($content eq q!<I ><STRONG>"THIS IS A TEST"</STRONG></I >!);
@@ -1,46 +0,0 @@
-use File::Spec;
-use File::Find qw(find);
-
-use strict;
-
-# make sure documentation isn't broken
-
-eval {
- # if we have both Test::More and Test::Pod we're good to go
- require Test::More;
- Test::More->import;
- require Test::Pod;
- Test::Pod->import;
-};
-
-if ($@) {
- # otherwise we need to plan accordingly - either
- # using Test::More or Test.pm syntax
- eval {
- require Test::More;
- };
-
- if ($@) {
- require Test;
- Test->import;
- plan(tests => 0);
- }
- else {
- plan(skip_all => 'Test::Pod required for testing POD');
- }
-}
-else {
- my @files;
-
- find(
- sub { push @files, $File::Find::name if m!\.p(m|od|l)$! },
- File::Spec->catfile(qw(.. blib lib))
- );
-
- plan(tests => scalar @files);
-
- foreach my $file (@files) {
- # use the older Test::Pod interface for maximum back compat
- pod_ok($file);
- }
-}
@@ -1,20 +0,0 @@
-package My::DynamicHTML;
-
-use Apache2::RequestIO (); # for $r->print
-use Apache2::RequestRec (); # for $r->content_type
-
-use Apache2::Const -compile => qw(OK);
-
-use strict;
-
-sub handler {
-
- my $r = shift;
-
- $r->content_type('text/html');
- $r->print(q!<i ><strong>"This is a test"</strong></i >!);
-
- return Apache2::Const::OK;
-}
-
-1;
@@ -1,24 +0,0 @@
-package My::Extra;
-
-use Apache2::RequestIO (); # for $r->print
-use Apache2::RequestRec (); # for $r->content_type
-
-use Apache2::Const -compile => qw(OK);
-
-use strict;
-
-sub handler {
-
- my $r = shift;
-
- $r->content_type('text/html');
-
- # leave some rogue tag dangling off our HTML,
- # as if there were some improperly formatted
- # data or something
- $r->print('x' x 1020 . '</body></html');
-
- return Apache2::Const::OK;
-}
-
-1;
@@ -1,21 +0,0 @@
-package My::Long;
-
-use Apache2::RequestIO (); # for $r->print
-use Apache2::RequestRec (); # for $r->content_type
-
-use Apache2::Const -compile => qw(OK);
-
-use strict;
-
-sub handler {
-
- my $r = shift;
-
- $r->content_type('text/html');
- my $buffer = 'x' x $r->args;
- $r->print(qq!$buffer<strong></strong>!);
-
- return Apache2::Const::OK;
-}
-
-1;
@@ -1,20 +0,0 @@
-package My::PlainHandler;
-
-use Apache2::RequestIO (); # for $r->print
-use Apache2::RequestRec (); # for $r->content_type
-
-use Apache2::Const -compile => qw(OK);
-
-use strict;
-
-sub handler {
-
- my $r = shift;
-
- $r->content_type('text/plain');
- $r->print(q!<i ><strong>"This is a test"</strong></i >!);
-
- return Apache2::Const::OK;
-}
-
-1;
@@ -1,20 +0,0 @@
-package My::Uppercase;
-
-use Apache2::Filter ();
-
-use Apache2::Const -compile => qw(OK);
-
-use strict;
-
-sub handler {
-
- my $f = shift;
-
- while ($f->read(my $buffer, 1024)) {
- $f->print(uc $buffer);
- }
-
- return Apache2::Const::OK;
-}
-
-1;
@@ -0,0 +1,8 @@
+#!perl
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestRunPerl();
+
+Apache::TestRunPerl->new->run(@ARGV);
@@ -1,88 +1,46 @@
-PerlSwitches -w
-
-LogLevel debug
-
-AddDefaultCharset On
+<Location /hooks>
+ SetHandler perl-script
+ PerlHandler 'sub { use mod_perl qw(PerlStackedHandlers PerlFileApi); \
+ shift->send_http_header(); \
+ return Apache::Constants::OK; \
+ }'
+</Location>
Alias /level @DocumentRoot@
<Location /level>
- PerlOutputFilterHandler Apache::Clean
- PerlSetVar CleanLevel 2
+ SetHandler perl-script
+ PerlHandler Apache::Clean
+ PerlSetVar CleanLevel 1
</Location>
Alias /option @DocumentRoot@
<Location /option>
- PerlOutputFilterHandler Apache::Clean
-
+ SetHandler perl-script
+ PerlHandler Apache::Clean
PerlSetVar CleanOption shortertags
PerlAddVar CleanOption entities
PerlAddVar CleanOption whitespace
</Location>
-Alias /perl-bin @ServerRoot@/perl-bin
-<Location /perl-bin>
+Alias /filter @DocumentRoot@
+<Location /filter>
SetHandler perl-script
- PerlResponseHandler ModPerl::Registry
-
- SetOutputFilter INCLUDES
- PerlOutputFilterHandler Apache::Clean
-
- PerlSetVar CleanOption shortertags
- PerlAddVar CleanOption whitespace
- Options +ExecCGI +Includes
-</Location>
-
-Alias /cgi-bin @ServerRoot@/cgi-bin
-<Location /cgi-bin>
- SetHandler cgi-script
-
- SetOutputFilter INCLUDES
- PerlOutputFilterHandler Apache::Clean
-
- PerlSetVar CleanOption shortertags
- PerlAddVar CleanOption whitespace
- Options +ExecCGI +Includes
+ PerlHandler Apache::Clean Apache::Clean
+ PerlSetVar CleanLevel 3
+ PerlSetVar Filter On
</Location>
<Location /plain-dynamic>
- SetHandler modperl
- PerlResponseHandler My::PlainHandler
- PerlOutputFilterHandler Apache::Clean
-
- PerlSetVar CleanOption shortertags
- PerlAddVar CleanOption whitespace
-</Location>
-
-<Location /html-dynamic>
- SetHandler modperl
- PerlResponseHandler My::DynamicHTML
- PerlOutputFilterHandler Apache::Clean
-
- PerlSetVar CleanOption shortertags
- PerlAddVar CleanOption whitespace
-</Location>
-
-<Location /long>
- SetHandler modperl
- PerlResponseHandler My::Long
- PerlOutputFilterHandler Apache::Clean
-
- PerlSetVar CleanOption shortertags
+ SetHandler perl-script
+ PerlHandler My::PlainHandler Apache::Clean
+ PerlSetVar Filter On
</Location>
-<Location /extra>
- SetHandler modperl
- PerlResponseHandler My::Extra
- PerlOutputFilterHandler Apache::Clean
-
- PerlSetVar CleanOption shortertags
+Alias /plain-static @DocumentRoot@
+<Location /plain-static>
+ SetHandler perl-script
+ PerlHandler Apache::Clean My::DoNothingHandler
+ PerlSetVar Filter On
</Location>
-<Location /decline>
- SetHandler modperl
- PerlResponseHandler My::PlainHandler
- PerlOutputFilterHandler Apache::Clean My::Uppercase
-
- PerlSetVar CleanOption shortertags
- PerlAddVar CleanOption whitespace
-</Location>
+LogLevel debug
@@ -0,0 +1,24 @@
+eval "require Apache::Filter";
+
+sub My::PlainHandler {
+ my $r = shift->filter_register;
+
+ $r->send_http_header('text/plain');
+ print "This is a plain test";
+
+ return Apache::Constants::OK;
+}
+
+sub My::DoNothingHandler {
+ my $r = shift->filter_register;
+
+ my ($fh, $status) = $r->filter_input;
+
+ return $status unless $status == OK;
+
+ $r->send_http_header($r->content_type);
+ print while <$fh>;
+
+ return OK;
+}
+1;
@@ -1 +1 @@
-<i ><strong>"This is a test"</strong></i >
+<strong>"This is a test"</strong><i > </i >
@@ -1 +1 @@
-<i ><strong>"This is a test"</strong></i >
+This is a plain test
@@ -1,2 +0,0 @@
-shift->content_type('text/html');
-print '<strong><!--#echo var="DOCUMENT_URI" --></strong>';
@@ -1,2 +0,0 @@
-shift->content_type('text/plain');
-print '<strong><!--#echo var="DOCUMENT_URI" --></strong>';