home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Apache.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-03  |  7.3 KB  |  225 lines
  1. #============================================================= -*-Perl-*-
  2. #
  3. # Template::Service::Apache
  4. #
  5. # DESCRIPTION
  6. #   Module subclassed from Template::Service which implements a service 
  7. #   specific to the Apache/mod_perl environment.
  8. #
  9. # AUTHOR
  10. #   Andy Wardley   <abw@kfs.org>
  11. #
  12. # COPYRIGHT
  13. #   Copyright (C) 1996-2001 Andy Wardley.  All Rights Reserved.
  14. #   Copyright (C) 1998-2001 Canon Research Centre Europe Ltd.
  15. #
  16. #   This module is free software; you can redistribute it and/or
  17. #   modify it under the same terms as Perl itself.
  18. # 
  19. #----------------------------------------------------------------------------
  20. #
  21. # $Id: Apache.pm,v 1.3 2002/03/12 14:08:29 abw Exp $
  22. #
  23. #============================================================================
  24.  
  25. package Template::Service::Apache;
  26.  
  27. require 5.004;
  28.  
  29. use strict;
  30. use vars qw( $VERSION $DEBUG $ERROR );
  31. use base qw( Template::Service );
  32. use Digest::MD5 qw( md5_hex );
  33. use Template::Config;
  34. use Template::Constants;
  35. use Template::Exception;
  36. use Template::Service;
  37.  
  38. $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
  39. $DEBUG   = 0 unless defined $DEBUG;
  40.  
  41. use Apache::Util qw( escape_path format_time );
  42. use Apache::Const -compile => qw( DECLINED SERVER_ERROR);
  43. use Apache::Log ();
  44. use Apache::RequestRec ();
  45. use Apache::Request 2.02;
  46.  
  47. #========================================================================
  48. #                     -----  PUBLIC METHODS -----
  49. #========================================================================
  50.  
  51. #------------------------------------------------------------------------
  52. # template($request)
  53. #
  54. # Fetch root template document from the ROOT_PROVIDER using the 
  55. # request filename.  Returns a reference to a Template::Document
  56. # object on success or a DECLINED status code if not found.  On error,
  57. # the relevant error message is logged and SERVER_ERROR is returned.
  58. #------------------------------------------------------------------------
  59.  
  60. sub template {
  61.     my ($self, $r) = @_;
  62.     my $filename = $r->filename();
  63.     
  64.     return Apache::DECLINED unless -f $filename;
  65.     $self->{ TEMPLATE_ERROR } = undef;
  66.  
  67.     my ($template, $error) = $self->{ ROOT_PROVIDER }->fetch($filename);
  68.     if ($error && $error == &Template::Constants::STATUS_DECLINED) {
  69.         return Apache::DECLINED;
  70.     }
  71.     elsif ($error) {
  72.         # save error as exception for params() to add to template vars
  73.         $self->{ TEMPLATE_ERROR } = Template::Exception->new(
  74.             Template::Constants::ERROR_FILE, $template
  75.         );
  76.         
  77.         # if there is an ERROR template defined then we attempt to 
  78.         # fetch it as a substitute for the original template.  Note 
  79.         # that we must fetch it from the regular template providers
  80.         # in the Template::Context because they honour the INCLUDE_PATH 
  81.         # parameters whereas the ROOT_PROVIDER expects an absolute file
  82.         
  83.         if ($template = $self->{ ERROR }) {
  84.             eval { $template = $self->{ CONTEXT }->template($template) };
  85.             if ($@) {
  86.                 $r->log_error($self->{ TEMPLATE_ERROR } . " / $@", ' ', $filename);
  87.                 return Apache::SERVER_ERROR;
  88.             }
  89.         }
  90.         else {
  91.             $r->log_error($template, ' ', $filename);
  92.             return Apache::SERVER_ERROR;
  93.         }
  94.     }
  95.     
  96.     return $template;
  97. }
  98.  
  99.  
  100. #------------------------------------------------------------------------
  101. # params($request, $params)
  102. #
  103. # Create a set of processing parameters (i.e. template variables) for
  104. # the request.
  105. #------------------------------------------------------------------------
  106.  
  107. sub params {
  108.     my ($self, $request, $params) = @_;
  109.     $params ||= { };
  110.  
  111.     my $plist = $self->{ SERVICE_PARAMS };
  112.     my $all = $plist->{ all };
  113.  
  114.     return $params unless keys %$plist;
  115.     $request = Apache::Request->new($request);
  116.  
  117.     $params->{ env } = { %{ $request->subprocess_env() } }
  118.         if $all or $plist->{ env };
  119.  
  120.     $params->{ uri } = $request->subprocess_env('REDIRECT_URL') || $request->uri()
  121.         if $all or $plist->{ uri };
  122.  
  123.     $params->{ pnotes } = $request->pnotes()
  124.         if $all or $plist->{ pnotes };
  125.  
  126.     $params->{ params } = { %{ $request->parms() } }
  127.         if $all or $plist->{ params };
  128.  
  129.     $params->{ request } = $request
  130.         if $all or $plist->{ request };
  131.  
  132.     if ($all or $plist->{ uploads }) {
  133.         my @uploads = $request->upload;
  134.         $params->{ uploads } = \@uploads;
  135.     }
  136.  
  137.     $params->{ cookies } = { 
  138.         map { $1 => escape_path($2, $request->pool) if (/([^=]+)=(.*)/) }
  139.         grep(!/^$/, split(/;\s*/, $request->header_in('cookie'))),
  140.     } if $all or $plist->{ cookies };
  141.     
  142.     # add any error raised by main template failure
  143.     $params->{ error } = $self->{ TEMPLATE_ERROR };
  144.  
  145.     return $params;
  146. }
  147.  
  148.  
  149. #------------------------------------------------------------------------
  150. # headers($request, $template, $content_ref)
  151. #
  152. # Set and then send the required http headers.
  153. #------------------------------------------------------------------------
  154.  
  155. sub headers {
  156.     my ($self, $r, $template, $content) = @_;
  157.     my $headers = $self->{ SERVICE_HEADERS };
  158.     my $all = $headers->{ all };
  159.  
  160.     $r->content_type('text/html');
  161.     $r->headers_out->add('Content-Length' => length $$content)
  162.         if $all or $headers->{ length };
  163.     $r->headers_out->add('E-tag' => sprintf q{"%s"}, md5_hex($$content))
  164.         if $all or $headers->{ etag };
  165.  
  166.     if ($all or $headers->{ modified } and $template) {
  167.         my $fmt = '%a, %d %b %Y %H:%M:%S %Z';
  168.  
  169.         my $ht_time = Apache::Util::format_time($template->modtime(),
  170.                                                 $fmt, 1, $r->pool);
  171.  
  172.         $r->headers_out->add('Last-Modified'  => $ht_time)
  173.     }
  174. }
  175.  
  176.  
  177. #------------------------------------------------------------------------
  178. # _init()
  179. #
  180. # In additional to the regular template providers (Template::Provider
  181. # objects) created as part of the context initialisation and used to
  182. # deliver templates loaded via INCLUDE, PROCESS, etc., we also create
  183. # a single additional provider responsible for loading the main
  184. # template.  We do this so that we can enable its ABSOLUTE flag,
  185. # allowing us to specify a requested template by absolute filename (as
  186. # Apache provides for us in $r->filename()) but without forcing all
  187. # other providers to honour the ABSOLUTE flag.  We pre-create a PARSER
  188. # object (Template::Parser) which can be shared across all providers.
  189. #------------------------------------------------------------------------
  190.  
  191. sub _init {
  192.     my ($self, $config) = @_;
  193.  
  194.     # create a parser to be shared by all providers
  195.     $config->{ PARSER } ||= Template::Config->parser($config) 
  196.         || return $self->error(Template::Config->error());
  197.  
  198.     # create a provider for the root document
  199.     my $rootcfg = {
  200.         ABSOLUTE => 1,
  201.         map { exists $config->{ $_ } ? ($_, $config->{ $_ }) : () }
  202.         qw( COMPILE_DIR COMPILE_EXT CACHE_SIZE PARSER ),
  203.     };
  204.  
  205.     my $rootprov = Template::Config->provider($rootcfg)
  206.         || return $self->error(Template::Config->error());
  207.  
  208.     # now let the Template::Service superclass initialiser continue
  209.     $self->SUPER::_init($config)
  210.         || return undef;
  211.  
  212.     # save reference to root document provider
  213.     $self->{ ROOT_PROVIDER } = $rootprov;
  214.  
  215.     # extract other relevant SERVICE_* config items
  216.     foreach (qw( SERVICE_HEADERS SERVICE_PARAMS )) {
  217.         my $item = $config->{ $_ } || [ ];
  218.         $self->{ $_ } = { map { $_ => 1 } @$item };
  219.     }
  220.     
  221.     return $self;
  222. }
  223.     
  224. 1;
  225.