template.pm

1. 记录每个帖子的访问人情况

More complicated usages are possible.  You can request that your
filter receieve the template text as an array of lines rather than as
a single scalar.  To do that you need to specify your filter using a
hash-ref.  In this form you specify the filter using the "sub" key and
the desired argument format using the "format" key.  The available
formats are "scalar" and "array".  Using the "array" format will incur
a performance penalty but may be more convenient in some situations.

   my $template = HTML::Template->new(filename => 'zap.tmpl',
                                      filter => { sub => $filter,
                                                  format => 'array' });

You may also have multiple filters.  This allows simple filters to be
combined for more elaborate functionality.  To do this you specify an
array of filters.  The filters are applied in the order they are
specified.

   my $template = HTML::Template->new(filename => 'zap.tmpl',
                                      filter => [ 
                                           { sub => \&decompress,
                                             format => 'scalar' },
                                           { sub => \&remove_spaces,
                                             format => 'array' }
                                        ]);

The specified filters will be called for any TMPL_INCLUDEed files just
as they are for the main template file.

=item *

vanguard_compatibility_mode - if set to 1 the module will expect to
see <TMPL_VAR>s that look like %NAME% in addition to the standard
syntax.  Also sets die_on_bad_params => 0.  If you're not at Vanguard
Media trying to use an old format template don't worry about this one.
Defaults to 0.

=item *

debug - if set to 1 the module will write random debugging information
to STDERR.  Defaults to 0.

=item *

stack_debug - if set to 1 the module will use Data::Dumper to print
out the contents of the parse_stack to STDERR.  Defaults to 0.

=item *

cache_debug - if set to 1 the module will send information on cache
loads, hits and misses to STDERR.  Defaults to 0.

=item *

shared_cache_debug - if set to 1 the module will turn on the debug
option in IPC::SharedCache - see L<IPC::SharedCache> for
details. Defaults to 0.

=item *

memory_debug - if set to 1 the module will send information on cache
memory usage to STDERR.  Requires the GTop module.  Defaults to 0.

=back 4

=cut


use integer; # no floating point math so far!
use strict; # and no funny business, either.

use Carp; # generate better errors with more context
use File::Spec; # generate paths that work on all platforms

# define accessor constants used to improve readability of array
# accesses into "objects".  I used to use 'use constant' but that
# seems to cause occasional irritating warnings in older Perls.
package HTML::Template::LOOP;
sub TEMPLATE_HASH { 0; }
sub PARAM_SET { 1 };

package HTML::Template::COND;
sub VARIABLE { 0 };
sub VARIABLE_TYPE { 1 };
sub VARIABLE_TYPE_VAR { 0 };
sub VARIABLE_TYPE_LOOP { 1 };
sub JUMP_IF_TRUE { 2 };
sub JUMP_ADDRESS { 3 };
sub WHICH { 4 };
sub WHICH_IF { 0 };
sub WHICH_UNLESS { 1 };

# back to the main package scope.
package HTML::Template;

# open a new template and return an object handle
sub new {
  my $pkg = shift;
  my $self; { my %hash; $self = bless(\%hash, $pkg); }

  # the options hash
  my $options = {};
  $self->{options} = $options;

  # set default parameters in options hash
  %$options = (
               debug => 0,
               stack_debug => 0,
               timing => 0,
               search_path_on_include => 0,
               cache => 0,               
               blind_cache => 0,
	       file_cache => 0,
	       file_cache_dir => '',
	       file_cache_dir_mode => 0700,
               cache_debug => 0,
               shared_cache_debug => 0,
               memory_debug => 0,
               die_on_bad_params => 1,
               vanguard_compatibility_mode => 0,
               associate => [],
               path => [],
               strict => 1,
               loop_context_vars => 0,
               max_includes => 10,
               shared_cache => 0,
               double_cache => 0,
               double_file_cache => 0,
               ipc_key => 'TMPL',
               ipc_mode => 0666,
               ipc_segment_size => 65536,
               ipc_max_size => 0,
               global_vars => 0,
               no_includes => 0,
               case_sensitive => 0,
               filter => [],
              );
  
  # load in options supplied to new()
  for (my $x = 0; $x <= $#_; $x += 2) {
    defined($_[($x + 1)]) or croak("HTML::Template->new() called with odd number of option parameters - should be of the form option => value");
    $options->{lc($_[$x])} = $_[($x + 1)]; 
  }

  # blind_cache = 1 implies cache = 1
  $options->{blind_cache} and $options->{cache} = 1;

  # shared_cache = 1 implies cache = 1
  $options->{shared_cache} and $options->{cache} = 1;

  # file_cache = 1 implies cache = 1
  $options->{file_cache} and $options->{cache} = 1;

  # double_cache is a combination of shared_cache and cache.
  $options->{double_cache} and $options->{cache} = 1;
  $options->{double_cache} and $options->{shared_cache} = 1;

  # double_file_cache is a combination of file_cache and cache.
  $options->{double_file_cache} and $options->{cache} = 1;
  $options->{double_file_cache} and $options->{file_cache} = 1;

  # vanguard_compatibility_mode implies die_on_bad_params = 0
  $options->{vanguard_compatibility_mode} and 
    $options->{die_on_bad_params} = 0;

  # handle the "type", "source" parameter format (does anyone use it?)
  if (exists($options->{type})) {
    exists($options->{source}) or croak("HTML::Template->new() called with 'type' parameter set, but no 'source'!");
    ($options->{type} eq 'filename' or $options->{type} eq 'scalarref' or
     $options->{type} eq 'arrayref' or $options->{type} eq 'filehandle') or
       croak("HTML::Template->new() : type parameter must be set to 'filename', 'arrayref', 'scalarref' or 'filehandle'!");

    $options->{$options->{type}} = $options->{source};
    delete $options->{type};
    delete $options->{source};
  }

  # associate should be an array of one element if it's not
  # already an array.
  if (ref($options->{associate}) ne 'ARRAY') {
    $options->{associate} = [ $options->{associate} ];
  }

  # path should be an array if it's not already
  if (ref($options->{path}) ne 'ARRAY') {
    $options->{path} = [ $options->{path} ];
  }

  # filter should be an array if it's not already
  if (ref($options->{filter}) ne 'ARRAY') {
    $options->{filter} = [ $options->{filter} ];
  }
  
  # make sure objects in associate area support param()
  foreach my $object (@{$options->{associate}}) {
    defined($object->can('param')) or
      croak("HTML::Template->new called with associate option, containing object of type " . ref($object) . " which lacks a param() method!");
  } 

  # check for syntax errors:
  my $source_count = 0;
  exists($options->{filename}) and $source_count++;
  exists($options->{filehandle}) and $source_count++;
  exists($options->{arrayref}) and $source_count++;
  exists($options->{scalarref}) and $source_count++;
  if ($source_count != 1) {
    croak("HTML::Template->new called with multiple (or no) template sources specified!  A valid call to new() has exactly one filename => 'file' OR exactly one scalarref => \\\$scalar OR exactly one arrayref => \\\@array OR exactly one filehandle => \*FH");
  }

  # do some memory debugging - this is best started as early as possible
  if ($options->{memory_debug}) {
    # memory_debug needs GTop
    eval { require GTop; };
    croak("Could not load GTop.  You must have GTop installed to use HTML::Template in memory_debug mode.  The error was: $@")
      if ($@);
    $self->{gtop} = GTop->new();
    $self->{proc_mem} = $self->{gtop}->proc_mem($$);
    print STDERR "\n### HTML::Template Memory Debug ### START ", $self->{proc_mem}->size(), "\n";
  }

  if ($options->{file_cache}) {
    # make sure we have a file_cache_dir option
    croak("You must specify the file_cache_dir option if you want to use file_cache.") 
      unless defined $options->{file_cache_dir} and 
        length $options->{file_cache_dir};

    # file_cache needs some extra modules loaded
    eval { require Storable; };
    croak("Could not load Storable.  You must have Storable installed to use HTML::Template in file_cache mode.  The error was: $@")
      if ($@);
    eval { require Digest::MD5; };
    croak("Could not load Digest::MD5.  You must have Digest::MD5 installed to use HTML::Template in file_cache mode.  The error was: $@")
      if ($@);
  }

  if ($options->{shared_cache}) {
    # shared_cache needs some extra modules loaded
    eval { require IPC::SharedCache; };
    croak("Could not load IPC::SharedCache.  You must have IPC::SharedCache installed to use HTML::Template in shared_cache mode.  The error was: $@")
      if ($@);

    # initialize the shared cache
    my %cache;
    tie %cache, 'IPC::SharedCache',
      ipc_key => $options->{ipc_key},
      load_callback => [\&_load_shared_cache, $self],
      validate_callback => [\&_validate_shared_cache, $self],
      debug => $options->{shared_cache_debug},
      ipc_mode => $options->{ipc_mode},
      max_size => $options->{ipc_max_size},
      ipc_segment_size => $options->{ipc_segment_size};
    $self->{cache} = \%cache;
  }

  print STDERR "### HTML::Template Memory Debug ### POST CACHE INIT ", $self->{proc_mem}->size(), "\n"
    if $options->{memory_debug};

  # initialize data structures
  $self->_init;
  
  print STDERR "### HTML::Template Memory Debug ### POST _INIT CALL ", $self->{proc_mem}->size(), "\n"
    if $options->{memory_debug};
  
  # drop the shared cache - leaving out this step results in the
  # template object evading garbage collection since the callbacks in
  # the shared cache tie hold references to $self!  This was not easy
  # to find, by the way.
  delete $self->{cache} if $options->{shared_cache};

  return $self;
}

# an internally used new that receives its parse_stack and param_map as input
sub _new_from_loop {
  my $pkg = shift;
  my $self; { my %hash; $self = bless(\%hash, $pkg); }

  # the options hash
  my $options = {};
  $self->{options} = $options;

  # set default parameters in options hash - a subset of the options
  # valid in a normal new().  Since _new_from_loop never calls _init,
  # many options have no relevance.
  %$options = (
               debug => 0,
               stack_debug => 0,
               die_on_bad_params => 1,
               associate => [],
               loop_context_vars => 0,
              );
  
  # load in options supplied to new()
  for (my $x = 0; $x <= $#_; $x += 2) { 
    defined($_[($x + 1)]) or croak("HTML::Template->new() called with odd number of option parameters - should be of the form option => value");
    $options->{lc($_[$x])} = $_[($x + 1)]; 
  }

  $self->{param_map} = $options->{param_map};
  $self->{parse_stack} = $options->{parse_stack};
  delete($options->{param_map});
  delete($options->{parse_stack});

  return $self;
}

# a few shortcuts to new(), of possible use...
sub new_file {
  my $pkg = shift; return $pkg->new('filename', @_);
}
sub new_filehandle {
  my $pkg = shift; return $pkg->new('filehandle', @_);
}
sub new_array_ref {
  my $pkg = shift; return $pkg->new('arrayref', @_);
}
sub new_scalar_ref {
  my $pkg = shift; return $pkg->new('scalarref', @_);
}

# initializes all the object data structures, either from cache or by
# calling the appropriate routines.
sub _init {
  my $self = shift;
  my $options = $self->{options};

  if ($options->{double_cache}) {
    # try the normal cache, return if we have it.
    $self->_fetch_from_cache();
    return if (defined $self->{param_map} and defined $self->{parse_stack});

    # try the shared cache
    $self->_fetch_from_shared_cache();

    # put it in the local cache if we got it.
    $self->_commit_to_cache()
      if (defined $self->{param_map} and defined $self->{parse_stack});
  } elsif ($options->{double_file_cache}) {
    # try the normal cache, return if we have it.
    $self->_fetch_from_cache();
    return if (defined $self->{param_map} and defined $self->{parse_stack});

    # try the file cache
    $self->_fetch_from_file_cache();

    # put it in the local cache if we got it.
    $self->_commit_to_cache()
      if (defined $self->{param_map} and defined $self->{parse_stack});
  } elsif ($options->{shared_cache}) {
    # try the shared cache
    $self->_fetch_from_shared_cache();
  } elsif ($options->{file_cache}) {
    # try the file cache
    $self->_fetch_from_file_cache();
  } elsif ($options->{cache}) {
    # try the normal cache
    $self->_fetch_from_cache();
  }
  
  # if we got a cache hit, return
  return if (defined $self->{param_map} and defined $self->{parse_stack});

  # if we're here, then we didn't get a cached copy, so do a full
  # init.
  $self->_init_template();
  $self->_parse();

  # now that we have a full init, cache the structures if cacheing is
  # on.  shared cache is already cool.
  if($options->{file_cache}){