view release on metacpan or  search on metacpan

lib/CAM/Template.pm  view on Meta::CPAN

#==============================

# PRIVATE FUNCTION
sub _preparse
{
   my $self = shift;

   my $content = $self->{content};
   return $self if ($content->{parsed});

   $content->{skip} = {};
   $content->{studied} = 0;
   $content->{loops} = {};
   $content->{loop_cache} = {};
   $content->{staticparams} = {};

   # Retrieve constant parameters set in the template files
   my $static_re = $self->{patterns}->{staticvars};
   $content->{string} =~ s/$static_re/$$content{staticparams}{$1}=$2; ""/ge;

   # Break up all loops
   my $re1 = $self->{patterns}->{loopstart};
   my $re2 = $self->{patterns}->{loopend};
   my ($start,$end) = split /\$1/, $self->{patterns}->{loop_out}, 2;
   my @parts = split /$re1/, $content->{string};
   while (@parts > 2) {
      my $tail = pop @parts;
      my $name = pop @parts;
      if ($tail =~ s/^(.*?)$re2/$start$name$end/s)
      {
         $content->{loops}->{$name} = $1;
      }
      else
      {
         warn "Found loop start for '$name' but no loop end";         
      }
      $parts[$#parts] .= $tail;
   }
   $content->{string} = $parts[0];
   $content->{parsed} = 1;

   return $self;
}
#==============================

# PRIVATE FUNCTION
sub _fetchfile
{
   my $self = shift;
   my $filename = shift;

   my $cache;
   if ($self->{use_cache})
   {
      my $pkg = ref($self);
      $global_filecache{$pkg} ||= {};
      $cache = $global_filecache{$pkg};
   }
   
   if ($self->{use_cache} && exists $cache->{$filename} &&
       $cache->{$filename}->{time} >= (stat($filename))[9])
   {
      return $cache->{$filename};
   }
   else
   {
      my $struct = {
         studied => 0,
         skip => {},
      };
      local *FILE;
      if (!open(FILE, $filename))
      {
         &carp("Failed to open file '$filename': $!");
         return undef;
      }
      local $/ = undef;
      $struct->{string} = <FILE>;
      close(FILE);

      if ($self->{include_files})
      {
         # Recursively add included files -- must be in the same directory
         my $dir = $filename;
         $dir =~ s,/[^/]+$,,;  # remove filename
         $dir .= "/" if ($dir =~ /[^\/]$/);
         my $re = $self->{patterns}->{include};
         $struct->{string} =~ s/$re/ $self->_fetchfile("$dir$1")->{string} /ge;
      }

      if ($self->{use_cache})
      {
         $struct->{time} = (stat($filename))[9];
         $cache->{$filename} = $struct;
      }
      return $struct;
   }
}

#==============================

=item toString

Executes the search/replace and returns the content.

=cut

sub toString
{
   my $self = shift;

   return "" unless ($self->{content});
   my $content = $self->{content}->{string};
   return "" unless (defined $content);

   my $re_hash = $self->{patterns};
   my $skip = $self->{content}->{skip};
   {
      # Turn off warnings, since it is likely that some parameters
      # will be undefined
      no warnings;

      # incoming params can override template params
      my %params = (
         "__filename__" => $self->{filename},
         %{$self->{content}->{staticparams}},
         %{$self->{params}},
      );

      unless ($skip->{cond})
      {
         # Do the following multiple times to handle nested conditionals

         if ($re_hash->{if} && $re_hash->{unless}) # legacy subclassing
         {

            &carp("DEPRECATED: please use 'ifunless' instead of 'if' and 'unless'\n" .
                  "in your patterns.  There was a subtle bug in the old way, and\n" .
                  "the new way is too slow with 'if' and 'unless'\n");

            my $pos = 1;
            my $neg = 1;
            do {
               if ($neg)
               {
                  $neg = ($content =~ s/$$re_hash{unless}/(!$params{$1}) ? $2 : ''/ge);
               }
               if ($pos)
               {
                  $pos = ($content =~ s/$$re_hash{if}/$params{$1} ? $2 : ''/ge);
               }
            } while ($neg || $pos);
         }