home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Clean.pm < prev    next >
Encoding:
Perl POD Document  |  2002-11-01  |  4.6 KB  |  188 lines
  1. package Apache::Clean;
  2.  
  3. use Apache::Filter ();      # for filtering
  4. use Apache::RequestRec ();  # for $r->content_type
  5. use Apache::RequestUtil (); # for $r->dir_config 
  6. use Apache::Response ();    # for $r->update_mtime
  7. use Apache::ServerUtil ();  # for Apache->server_root_relative
  8. use APR::Table ();          # for $r->dir_config->get
  9. use Apache::Log ();         # for $r->server->log;
  10.  
  11. use Apache::Const -compile => qw(OK DECLINED);
  12.  
  13. use HTML::Clean;
  14. use File::Spec;
  15. use strict;
  16.  
  17. $Apache::Clean::VERSION = '2.00b';
  18.  
  19. # Get the package modification time for later update_mtime() calls
  20. (my $package = __PACKAGE__) =~ s!::!/!g;
  21. my $package_mtime = (stat $INC{"$package.pm"})[9];
  22.  
  23. sub handler {
  24.  
  25.   my $filter = shift;
  26.  
  27.   my $r      = $filter->r;
  28.  
  29.   my $log    = $r->server->log;
  30.  
  31.   $log->info('Using Apache::Clean to clean up ', $r->uri);
  32.  
  33.   unless ($r->content_type =~ m!text/html!i) {
  34.     $log->info('skipping request to', $r->uri,
  35.                ' (not an HTML document)' );
  36.  
  37.     $log->info('Exiting Apache::Clean');
  38.  
  39.     return Apache::DECLINED;
  40.   }
  41.  
  42.   # parse the configuration options
  43.   my $level = $r->dir_config->get('CleanLevel') || 1;
  44.  
  45.   $log->info("Using CleanLevel $level");
  46.  
  47.   my %options = map { $_ => 1 } $r->dir_config->get('CleanOption');
  48.  
  49.   $log->info('Found CleanOption ', join " : ", keys %options)
  50.     if %options;
  51.     
  52.   # update only the package modification time for now - 
  53.   # I need to investigate per-server cleanups in 2.0 more
  54.  
  55.   # a few notes about caching headers...
  56.   #   - the file mtime itself is handled by core Apache
  57.   #   - this all needs to happen _before_ we start interacting
  58.   #     with the filter
  59.   
  60.   $log->debug("updating headers with package mtime $package_mtime...");
  61.   $r->update_mtime($package_mtime);
  62.   $r->set_last_modified;
  63.  
  64.   # now we can filter the content
  65.   while ($filter->read(my $buffer, 1024)) {
  66.  
  67.     $log->debug('filtering packet...');
  68.  
  69.     my $h = HTML::Clean->new(\$buffer);
  70.  
  71.     $h->level($level);
  72.  
  73.     $h->strip(\%options);
  74.  
  75.     $filter->print(${$h->data});
  76.   }
  77.  
  78.   $log->info('Exiting Apache::Clean');
  79.  
  80.   return Apache::OK;
  81. }
  82.  
  83. 1;
  84.  
  85. __END__
  86.  
  87. =head1 NAME 
  88.  
  89. Apache::Clean - mod_perl interface into HTML::Clean
  90.  
  91. =head1 SYNOPSIS
  92.  
  93. httpd.conf:
  94.  
  95.  PerlModule Apache::Clean
  96.  
  97.  <Location /clean>
  98.     PerlOutputFilterHandler Apache::Clean
  99.  
  100.     PerlSetVar  CleanLevel 3
  101.  
  102.     PerlSetVar  CleanOption shortertags
  103.     PerlAddVar  CleanOption whitespace
  104.  </Location>  
  105.  
  106. =head1 DESCRIPTION
  107.  
  108. Apache::Clean uses HTML::Clean to tidy up large, messy HTML, saving
  109. bandwidth.  It is particularly useful with Apache::Compress for 
  110. ultimate savings.
  111.  
  112. Only documents with a content type of "text/html" are affected - all
  113. others are passed through unaltered.
  114.  
  115. Apache::Clean also tries to be intelligent about setting proper
  116. caching headers.  For the moment, it only considers the modification
  117. time of itself in the header calculations.  Future versions may
  118. consider things like httpd.conf and .htaccess files.  Note that
  119. the core Apache content handler takes care of updating cache headers
  120. for static files - if you are using a dynamic content handler you
  121. need to do that one yourself.
  122.  
  123. =head1 OPTIONS
  124.  
  125. Apache::Clean supports few options - all of which are based on
  126. options from HTML::Clean.  Apache::Clean will only tidy up whitespace 
  127. (via $h->strip) and will not perform other options of HTML::Clean
  128. (such as browser compatibility).  See the HTML::Clean manpage for 
  129. details.
  130.  
  131. =over 4
  132.  
  133. =item CleanLevel
  134.  
  135. sets the clean level, which is passed to the level() method
  136. in HTML::Clean.
  137.  
  138.   PerlSetVar CleanLevel 9
  139.  
  140. CleanLevel defaults to 3.
  141.  
  142. =item CleanOption
  143.  
  144. specifies the set of options which are passed to the options()
  145. method in HTML::Clean.
  146.  
  147.   PerlAddVar CleanOption shortertags
  148.   PerlSetVar CleanOption whitespace
  149.  
  150. CleanOption has do default.
  151.  
  152. =back
  153.  
  154. =head1 NOTES
  155.  
  156. This is alpha software, and as such has not been tested on multiple
  157. platforms or environments.
  158.  
  159. =head1 FEATURES/BUGS
  160.  
  161. probably lots - this is the preliminary port to mod_perl 2.0
  162.  
  163. =head1 SEE ALSO
  164.  
  165. perl(1), mod_perl(3), Apache(3), HTML::Clean(3)
  166.  
  167. =head1 AUTHORS
  168.  
  169. Geoffrey Young <geoff@modperlcookbook.org>
  170.  
  171. =head1 COPYRIGHT
  172.  
  173. Copyright (c) 2002, Geoffrey Young
  174. All rights reserved.
  175.  
  176. This module is free software.  It may be used, redistributed
  177. and/or modified under the same terms as Perl itself.
  178.  
  179. =head1 HISTORY
  180.  
  181. This code is derived from the Cookbook::Clean and
  182. Cookbook::TestMe modules available as part of
  183. "The mod_perl Developer's Cookbook".
  184.  
  185. For more information, visit http://www.modperlcookbook.org/
  186.  
  187. =cut
  188.