template.pm

稀饭伊人相册系统继承了新天堂多用户相册系统的功能

    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}){
    $self->_commit_to_file_cache();
  }
  $self->_commit_to_cache() if (($options->{cache}
                                and not $options->{shared_cache}
				and not $options->{file_cache}) or
                                ($options->{double_cache}) or
				($options->{double_file_cache}));
}

# Caching subroutines - they handle getting and validating cache
# records from either the in-memory or shared caches.

# handles the normal in memory cache
use vars qw( %CACHE );
sub _fetch_from_cache {
  my $self = shift;
  my $options = $self->{options};

  # return if there's no file here
  return unless exists($options->{filename});
  my $filepath = $self->_find_file($options->{filename});
  return unless (defined($filepath));
  $options->{filepath} = $filepath;

  # return if there's no cache entry for this key
  my $key = $self->_cache_key();
  return unless exists($CACHE{$key});  
  
  # validate the cache
  my $mtime = $self->_mtime($filepath);  
  if (defined $mtime) {
    # return if the mtime doesn't match the cache
    if (defined($CACHE{$key}{mtime}) and 
        ($mtime != $CACHE{$key}{mtime})) {
      $options->{cache_debug} and 
        print STDERR "CACHE MISS : $filepath : $mtime\n";
      return;
    }

    # if the template has includes, check each included file's mtime
    # and return if different
    if (exists($CACHE{$key}{included_mtimes})) {
      foreach my $filename (keys %{$CACHE{$key}{included_mtimes}}) {
        next unless 
          defined($CACHE{$key}{included_mtimes}{$filename});
        
        my $included_mtime = (stat($filename))[9];
        if ($included_mtime != $CACHE{$key}{included_mtimes}{$filename}) {
          $options->{cache_debug} and 
            print STDERR "### HTML::Template Cache Debug ### CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n";
          
          return;
        }
      }
    }
  }

  # got a cache hit!
  
  $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### CACHE HIT : $filepath => $key\n";
      
  $self->{param_map} = $CACHE{$key}{param_map};
  $self->{parse_stack} = $CACHE{$key}{parse_stack};
  exists($CACHE{$key}{included_mtimes}) and
    $self->{included_mtimes} = $CACHE{$key}{included_mtimes};

  # clear out values from param_map from last run
  $self->_normalize_options();
  $self->clear_params();
}

sub _commit_to_cache {
  my $self     = shift;
  my $options  = $self->{options};
  my $key      = $self->_cache_key();
  my $filepath = $options->{filepath};

  $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### CACHE LOAD : $filepath => $key\n";
    
  $options->{blind_cache} or
    $CACHE{$key}{mtime} = $self->_mtime($filepath);
  $CACHE{$key}{param_map} = $self->{param_map};
  $CACHE{$key}{parse_stack} = $self->{parse_stack};
  exists($self->{included_mtimes}) and
    $CACHE{$key}{included_mtimes} = $self->{included_mtimes};
}

# create a cache key from a template object.  The cache key includes
# the full path to the template and options which affect template
# loading.  Has the side-effect of loading $self->{options}{filepath}
sub _cache_key {
    my $self = shift;
    my $options = $self->{options};

    # determine path to file unless already known
    my $filepath = $options->{filepath};
    if (not defined $filepath) {
        $filepath = $self->_find_file($options->{filename});
        confess("HTML::Template->new() : Cannot find file '$options->{filename}'.")
          unless defined($filepath);
        $options->{filepath} = $filepath;   
    }

    # assemble pieces of the key
    my @key = ($filepath);
    push(@key, @{$options->{path}}) if $options->{path};
    push(@key, $options->{search_path_on_include} || 0);
    push(@key, $options->{loop_context_vars} || 0);
    push(@key, $options->{global_vars} || 0);

    # compute the md5 and return it
    return md5_hex(@key);
}

# generates MD5 from filepath to determine filename for cache file
sub _get_cache_filename {
  my ($self, $filepath) = @_;

  # get a cache key
  $self->{options}{filepath} = $filepath;
  my $hash = $self->_cache_key();
  
  # ... and build a path out of it.  Using the first two charcters
  # gives us 255 buckets.  This means you can have 255,000 templates
  # in the cache before any one directory gets over a few thousand
  # files in it.  That's probably pretty good for this planet.  If not
  # then it should be configurable.
  if (wantarray) {
    return (substr($hash,0,2), substr($hash,2))
  } else {
    return File::Spec->join($self->{options}{file_cache_dir}, 
                            substr($hash,0,2), substr($hash,2));
  }
}

# handles the file cache
sub _fetch_from_file_cache {
  my $self = shift;
  my $options = $self->{options};
  return unless exists($options->{filename});
  
  # return if there's no cache entry for this filename
  my $filepath = $self->_find_file($options->{filename});
  return unless defined $filepath;
  my $cache_filename = $self->_get_cache_filename($filepath);
  return unless -e $cache_filename;
  
  eval {
    $self->{record} = Storable::lock_retrieve($cache_filename);
  };
  croak("HTML::Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $@")
    if $@;
  croak("HTML::Template::new() - Problem reading cache file $cache_filename (file_cache => 1) : $!") 
    unless defined $self->{record};

  ($self->{mtime}, 
   $self->{included_mtimes}, 
   $self->{param_map}, 
   $self->{parse_stack}) = @{$self->{record}};
  
  $options->{filepath} = $filepath;

  # validate the cache
  my $mtime = $self->_mtime($filepath);
  if (defined $mtime) {
    # return if the mtime doesn't match the cache
    if (defined($self->{mtime}) and 
        ($mtime != $self->{mtime})) {
      $options->{cache_debug} and 
        print STDERR "### HTML::Template Cache Debug ### FILE CACHE MISS : $filepath : $mtime\n";
      ($self->{mtime}, 
       $self->{included_mtimes}, 
       $self->{param_map}, 
       $self->{parse_stack}) = (undef, undef, undef, undef);
      return;
    }

    # if the template has includes, check each included file's mtime
    # and return if different
    if (exists($self->{included_mtimes})) {
      foreach my $filename (keys %{$self->{included_mtimes}}) {
        next unless 
          defined($self->{included_mtimes}{$filename});
        
        my $included_mtime = (stat($filename))[9];
        if ($included_mtime != $self->{included_mtimes}{$filename}) {
          $options->{cache_debug} and 
            print STDERR "### HTML::Template Cache Debug ### FILE CACHE MISS : $filepath : INCLUDE $filename : $included_mtime\n";
          ($self->{mtime}, 
           $self->{included_mtimes}, 
           $self->{param_map}, 
           $self->{parse_stack}) = (undef, undef, undef, undef);
          return;
        }
      }
    }
  }

  # got a cache hit!
  $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### FILE CACHE HIT : $filepath\n";

  # clear out values from param_map from last run
  $self->_normalize_options();
  $self->clear_params();
}

sub _commit_to_file_cache {
  my $self = shift;
  my $options = $self->{options};

  my $filepath = $options->{filepath};
  if (not defined $filepath) {
    $filepath = $self->_find_file($options->{filename});
    confess("HTML::Template->new() : Cannot open included file $options->{filename} : file not found.")
      unless defined($filepath);
    $options->{filepath} = $filepath;   
  }

  my ($cache_dir, $cache_file) = $self->_get_cache_filename($filepath);  
  $cache_dir = File::Spec->join($options->{file_cache_dir}, $cache_dir);
  if (not -d $cache_dir) {
    if (not -d $options->{file_cache_dir}) {
      mkdir($options->{file_cache_dir},$options->{file_cache_dir_mode})
	or croak("HTML::Template->new() : can't mkdir $options->{file_cache_dir} (file_cache => 1): $!");
    }
    mkdir($cache_dir,$options->{file_cache_dir_mode})
      or croak("HTML::Template->new() : can't mkdir $cache_dir (file_cache => 1): $!");
  }

  $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### FILE CACHE LOAD : $options->{filepath}\n";

  my $result;
  eval {
    $result = Storable::lock_store([ $self->{mtime},
                                     $self->{included_mtimes}, 
                                     $self->{param_map}, 
                                     $self->{parse_stack} ],
                                   scalar File::Spec->join($cache_dir, $cache_file)
                                  );
  };
  croak("HTML::Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $@")
    if $@;
  croak("HTML::Template::new() - Problem writing cache file $cache_dir/$cache_file (file_cache => 1) : $!")
    unless defined $result;
}

# Shared cache routines.
sub _fetch_from_shared_cache {
  my $self = shift;
  my $options = $self->{options};