template.pm

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

  my $filepath = $self->_find_file($options->{filename});
  return unless defined $filepath;

  # fetch from the shared cache.
  $self->{record} = $self->{cache}{$filepath};
  
  ($self->{mtime}, 
   $self->{included_mtimes}, 
   $self->{param_map}, 
   $self->{parse_stack}) = @{$self->{record}}
     if defined($self->{record});
  
  $options->{cache_debug} and defined($self->{record}) and print STDERR "### HTML::Template Cache Debug ### CACHE HIT : $filepath\n";
  # clear out values from param_map from last run
  $self->_normalize_options(), $self->clear_params()
    if (defined($self->{record}));
  delete($self->{record});

  return $self;
}

sub _validate_shared_cache {
  my ($self, $filename, $record) = @_;
  my $options = $self->{options};

  $options->{shared_cache_debug} and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE VALIDATE : $filename\n";

  return 1 if $options->{blind_cache};

  my ($c_mtime, $included_mtimes, $param_map, $parse_stack) = @$record;

  # if the modification time has changed return false
  my $mtime = $self->_mtime($filename);
  if (defined $mtime and defined $c_mtime
      and $mtime != $c_mtime) {
    $options->{cache_debug} and 
      print STDERR "### HTML::Template Cache Debug ### SHARED CACHE MISS : $filename : $mtime\n";
    return 0;
  }

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

  # all done - return true
  return 1;
}

sub _load_shared_cache {
  my ($self, $filename) = @_;
  my $options = $self->{options};
  my $cache = $self->{cache};
  
  $self->_init_template();
  $self->_parse();

  $options->{cache_debug} and print STDERR "### HTML::Template Cache Debug ### SHARED CACHE LOAD : $options->{filepath}\n";
  
  print STDERR "### HTML::Template Memory Debug ### END CACHE LOAD ", $self->{proc_mem}->size(), "\n"
    if $options->{memory_debug};

  return [ $self->{mtime},
           $self->{included_mtimes}, 
           $self->{param_map}, 
           $self->{parse_stack} ]; 
}

# utility function - given a filename performs documented search and
# returns a full path of undef if the file cannot be found.
sub _find_file {
  my ($self, $filename, $extra_path) = @_;
  my $options = $self->{options};
  my $filepath;

  # first check for a full path
  return File::Spec->canonpath($filename)
    if (File::Spec->file_name_is_absolute($filename) and (-e $filename));

  # try the extra_path if one was specified
  if (defined($extra_path)) {
    $extra_path->[$#{$extra_path}] = $filename;
    $filepath = File::Spec->canonpath(File::Spec->catfile(@$extra_path));
    return File::Spec->canonpath($filepath) if -e $filepath;
  }

  # try pre-prending HTML_Template_Root
  if (exists($ENV{HTML_TEMPLATE_ROOT}) and defined($ENV{HTML_TEMPLATE_ROOT})) {
    $filepath =  File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $filename);
    return File::Spec->canonpath($filepath) if -e $filepath;
  }

  # try "path" option list..
  foreach my $path (@{$options->{path}}) {
    $filepath = File::Spec->catfile($path, $filename);
    return File::Spec->canonpath($filepath) if -e $filepath;
  }

  # try even a relative path from the current directory...
  return File::Spec->canonpath($filename) if -e $filename;

  # try "path" option list with HTML_TEMPLATE_ROOT prepended...
  if (exists($ENV{HTML_TEMPLATE_ROOT})) {
    foreach my $path (@{$options->{path}}) {
      $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $path, $filename);
      return File::Spec->canonpath($filepath) if -e $filepath;
    }
  }
  
  return undef;
}

# utility function - computes the mtime for $filename
sub _mtime {
  my ($self, $filepath) = @_;
  my $options = $self->{options};
  
  return(undef) if ($options->{blind_cache});

  # make sure it still exists in the filesystem 
  (-r $filepath) or Carp::confess("HTML::Template : template file $filepath does not exist or is unreadable.");
  
  # get the modification time
  return (stat(_))[9];
}

# utility function - enforces new() options across LOOPs that have
# come from a cache.  Otherwise they would have stale options hashes.
sub _normalize_options {
  my $self = shift;
  my $options = $self->{options};

  my @pstacks = ($self->{parse_stack});
  while(@pstacks) {
    my $pstack = pop(@pstacks);
    foreach my $item (@$pstack) {
      next unless (ref($item) eq 'HTML::Template::LOOP');
      foreach my $template (values %{$item->[HTML::Template::LOOP::TEMPLATE_HASH]}) {
        # must be the same list as the call to _new_from_loop...
        $template->{options}{debug} = $options->{debug};
        $template->{options}{stack_debug} = $options->{stack_debug};
        $template->{options}{die_on_bad_params} = $options->{die_on_bad_params};
        $template->{options}{case_sensitive} = $options->{case_sensitive};

        push(@pstacks, $template->{parse_stack});
      }
    }
  }
}      

# initialize the template buffer
sub _init_template {
  my $self = shift;
  my $options = $self->{options};

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

  if (exists($options->{filename})) {    
    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);
      # we'll need this for future reference - to call stat() for example.
      $options->{filepath} = $filepath;   
    }

    confess("HTML::Template->new() : Cannot open included file $options->{filename} : $!")
        unless defined(open(TEMPLATE, $filepath));
    $self->{mtime} = $self->_mtime($filepath);

    # read into scalar, note the mtime for the record
    $self->{template} = "";
    while (read(TEMPLATE, $self->{template}, 10240, length($self->{template}))) {}
    close(TEMPLATE);

  } elsif (exists($options->{scalarref})) {
    # copy in the template text
    $self->{template} = ${$options->{scalarref}};

    delete($options->{scalarref});
  } elsif (exists($options->{arrayref})) {
    # if we have an array ref, join and store the template text
    $self->{template} = join("", @{$options->{arrayref}});

    delete($options->{arrayref});
  } elsif (exists($options->{filehandle})) {
    # just read everything in in one go
    local $/ = undef;
    $self->{template} = readline($options->{filehandle});

    delete($options->{filehandle});
  } else {
    confess("HTML::Template : Need to call new with filename, filehandle, scalarref or arrayref parameter specified.");
  }

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

  # handle filters if necessary
  $self->_call_filters(\$self->{template}) if @{$options->{filter}};

  return $self;
}

# handle calling user defined filters
sub _call_filters {
  my $self = shift;
  my $template_ref = shift;
  my $options = $self->{options};

  my ($format, $sub);
  foreach my $filter (@{$options->{filter}}) {
    croak("HTML::Template->new() : bad value set for filter parameter - must be a code ref or a hash ref.")
      unless ref $filter;

    # translate into CODE->HASH
    $filter = { 'format' => 'scalar', 'sub' => $filter }
      if (ref $filter eq 'CODE');

    if (ref $filter eq 'HASH') {
      $format = $filter->{'format'};
      $sub = $filter->{'sub'};

      # check types and values
      croak("HTML::Template->new() : bad value set for filter parameter - hash must contain \"format\" key and \"sub\" key.")
        unless defined $format and defined $sub;
      croak("HTML::Template->new() : bad value set for filter parameter - \"format\" must be either 'array' or 'scalar'")
        unless $format eq 'array' or $format eq 'scalar';
      croak("HTML::Template->new() : bad value set for filter parameter - \"sub\" must be a code ref")
        unless ref $sub and ref $sub eq 'CODE';

      # catch errors
      eval {
        if ($format eq 'scalar') {
          # call
          $sub->($template_ref);
        } else {
	  # modulate
	  my @array = map { $_."\n" } split("\n", $$template_ref);
          # call
          $sub->(\@array);
	  # demodulate
	  $$template_ref = join("", @array);
        }
      };
      croak("HTML::Template->new() : fatal error occured during filter call: $@") if $@;
    } else {
      croak("HTML::Template->new() : bad value set for filter parameter - must be code ref or hash ref");
    }
  }
  # all done
  return $template_ref;
}

# _parse sifts through a template building up the param_map and
# parse_stack structures.
#
# The end result is a Template object that is fully ready for
# output().
sub _parse {
  my $self = shift;
  my $options = $self->{options};
  
  $options->{debug} and print STDERR "### HTML::Template Debug ### In _parse:\n";
  
  # setup the stacks and maps - they're accessed by typeglobs that
  # reference the top of the stack.  They are masked so that a loop
  # can transparently have its own versions.
  use vars qw(@pstack %pmap @ifstack @ucstack %top_pmap);
  local (*pstack, *ifstack, *pmap, *ucstack, *top_pmap);
  
  # the pstack is the array of scalar refs (plain text from the
  # template file), VARs, LOOPs, IFs and ELSEs that output() works on
  # to produce output.  Looking at output() should make it clear what
  # _parse is trying to accomplish.
  my @pstacks = ([]);
  *pstack = $pstacks[0];
  $self->{parse_stack} = $pstacks[0];
  
  # the pmap binds names to VARs, LOOPs and IFs.  It allows param() to
  # access the right variable.  NOTE: output() does not look at the
  # pmap at all!
  my @pmaps = ({});
  *pmap = $pmaps[0];
  *top_pmap = $pmaps[0];
  $self->{param_map} = $pmaps[0];

  # the ifstack is a temporary stack containing pending ifs and elses
  # waiting for a /if.
  my @ifstacks = ([]);
  *ifstack = $ifstacks[0];

  # the ucstack is a temporary stack containing conditions that need
  # to be bound to param_map entries when their block is finished.
  # This happens when a conditional is encountered before any other
  # reference to its NAME.  Since a conditional can reference VARs and
  # LOOPs it isn't possible to make the link right away.
  my @ucstacks = ([]);
  *ucstack = $ucstacks[0];
  
  # the loopstack is another temp stack for closing loops.  unlike
  # those above it doesn't get scoped inside loops, therefore it
  # doesn't need the typeglob magic.
  my @loopstack = ();

  # the fstack is a stack of filenames and counters that keeps track
  # of which file we're in and where we are in it.  This allows
  # accurate error messages even inside included files!
  # fcounter, fmax and fname are aliases for the current file's info
  use vars qw($fcounter $fname $fmax);
  local (*fcounter, *fname, *fmax);

  my @fstack = ([$options->{filepath} || "/fake/path/for/non/file/template",
                 1, 
                 scalar @{[$self->{template} =~ m/(\n)/g]} + 1
                ]);
  (*fname, *fcounter, *fmax) = \ ( @{$fstack[0]} );

  my $NOOP = HTML::Template::NOOP->new();
  my $ESCAPE = HTML::Template::ESCAPE->new();
  my $JSESCAPE = HTML::Template::JSESCAPE->new();
  my $URLESCAPE = HTML::Template::URLESCAPE->new();

  # all the tags that need NAMEs:
  my %need_names = map { $_ => 1 } 
    qw(TMPL_VAR TMPL_LOOP TMPL_IF TMPL_UNLESS TMPL_INCLUDE);
    
  # variables used below that don't need to be my'd in the loop
  my ($name, $which, $escape, $default);

  # handle the old vanguard format
  $options->{vanguard_compatibility_mode} and 
    $self->{template} =~ s/%([-\w\/\.+]+)%/<TMPL_VAR NAME=$1>/g;

  # now split up template on '<', leaving them in
  my @chunks = split(m/(?=<)/, $self->{template});

  # all done with template
  delete $self->{template};

  # loop through chunks, filling up pstack
  my $last_chunk =  $#chunks;
 CHUNK: for (my $chunk_number = 0;
	    $chunk_number <= $last_chunk;
	    $chunk_number++) {
    next unless defined $chunks[$chunk_number]; 
    my $chunk = $chunks[$chunk_number];
    
    # a general regex to match any and all TMPL_* tags 
    if ($chunk =~ /^<
                    (?:!--\s*)?
                    (
                      \/?[Tt][Mm][Pp][Ll]_