ktemplate.pm

Astercon2 开源软交换 2.2.0

		$line += ($text =~ tr/\n//);
		
		if ($CHOMP) {
			# delete newline after last block tag
			$space ? $text =~ s/^[ \t]*\r?\n// : $text =~ s/^[ \t]*\r?\n/ / if $block;
			
			# check this tag is not a var or include
			$block = $type && $type !~ /^[Ii]/ ? 1 : 0;
			$space = 0; # no space was added (default)
			
			# remove newline preceding this block tag
			$space = 1 if $block && $text =~ s/\r?\n[ \t]*\z/ /;
		}
		
		# the first element of the @pstacks array contains a reference
		# to the current parse stack where the template data is added.
		
		push @{$pstacks[0]}, [ TEXT, $text ] if defined $text;

		if (!defined $type) {
		
			push @{$pstacks[0]}, [ VAR, $ident ];
			
		} elsif ($type =~ /^[Bb]/) {
		
			croak("Parse error: invalid param in block tag at $filename line $line") 
				unless length $ident;
		
			# create a new parse stack were all data 
			# will be added until the block ends.
			unshift @pstacks, [];
			
			# create a reference to this new parse stack in the old one
			# so the block data doesn't get lost after the block ends.
			push @{$pstacks[1]}, [ BLOCK, $ident, $pstacks[0] ];
			
			# add block type and ident for syntax checking
			unshift @idents, [ 'BEGIN', $ident ];
			
		} elsif ($type =~ /^[Ee][Nn]/) {
			
			croak("Parse error: block closed but never opened at $filename line $line")
				if scalar @idents == 0;

			croak("Parse error: invalid param in block tag at $filename line $line")
				if defined $ident && (uc $ident eq 'BEGIN' || uc $ident ne $idents[0]->[TYPE])
				&& $ident ne $idents[0]->[IDENT];
			
			shift @pstacks;
			shift @idents;
			
		} elsif ($type =~ /^[Ii][Ff]/) {
		
			croak("Parse error: invalid param in if tag at $filename line $line") 
				unless length $ident;
		
			unshift  @pstacks,       [];
			push     @{$pstacks[1]}, [  IF , $ident, $pstacks[0] ];
			unshift  @idents,        [ 'IF', $ident ];
	
		} elsif ($type =~ /^[Uu]/) {
		
			croak("Parse error: invalid param in unless tag at $filename line $line")
				unless length $ident;
		
			unshift  @pstacks,       [];
			push     @{$pstacks[1]}, [  UNLESS , $ident, $pstacks[0] ];
			unshift  @idents,        [ 'UNLESS', $ident ];
			
		} elsif ($type =~ /^[Ee]/) {

			croak("Parse error: found else tag with no matching block at $filename line $line")
				if scalar @idents == 0;
				
			croak("Parse error: invalid param in else tag at $filename line $line")
				if defined $ident && $ident ne $idents[0]->[IDENT];
		
			shift   @pstacks;       # close current block
			unshift @pstacks, [];   # and create a new one.
			push    @{$pstacks[1]}, [ ELSE, undef, $pstacks[0] ];
		
		} elsif ($type =~ /^[Ii]/) {
		
			croak("Parse error: file to include not defined at $filename line $line") 
				unless length $ident;
		
			push @{$pstacks[0]}, [ FILE, $ident ];
			
		} elsif ($type =~ /^[Ll]/) {
		
			croak("Parse error: invalid param in loop tag at $filename line $line") 
				unless length $ident;

			unshift  @pstacks,       [];
			push     @{$pstacks[1]}, [  LOOP , $ident, $pstacks[0] ];
			unshift  @idents,        [ 'LOOP', $ident ];

		}

		# tag might contain newline
		$line += ($tag =~ tr/\n//);

	}

	# chomp and add remaining text not recognized by the regexp
	$$filedata =~ s/^[ \t]*\n// if $CHOMP && $block; 
	push @{$pstacks[0]}, [ TEXT, $$filedata ];

	croak("Parse error: block not closed at $filename")
		if @idents > 0;

	return $pstacks[0];

}


sub _output {

	my $self = shift;
	my $stack = shift;
	my ($line, $looped);
	
	foreach $line (@$stack) { # create template output
		$line->[TYPE] == VAR    ? $self->{'output'} .= $self->_value( $line->[IDENT] ) :
		$line->[TYPE] == TEXT   ? $self->{'output'} .= $line->[IDENT] :
		$line->[TYPE] == FILE   ? $self->_include( $line->[IDENT] )   :
		$line->[TYPE] == BLOCK  ? $looped = $self->_loop( $line->[IDENT], $line->[STACK], BLOCK )  :
		$line->[TYPE] == IF     ? $looped = $self->_loop( $line->[IDENT], $line->[STACK], IF )     :
		$line->[TYPE] == LOOP   ? $looped = $self->_loop( $line->[IDENT], $line->[STACK], LOOP )   :
		$line->[TYPE] == UNLESS ? $looped = $self->_loop( $line->[IDENT], $line->[STACK], UNLESS ) :
		$line->[TYPE] == ELSE   ? $looped = $self->_loop( $looped, $line->[STACK], ELSE ) : next;
	}

}


sub _value {

	my $self  = shift;
	my $ident = shift;
	my $value = $self->_get($ident);
	
	unless (defined $value) {
		croak("No value found for variable $ident at " . $self->{'files'}->[0]->[NAME])
			if $self->{'config'}->{'strict'};
		return ''; # no strict
	}

	# if the value is a code reference the code
	# is called and the output is returned
	
	if (ref $value) {
		$value = &{$value} if ref $value eq 'CODE';
		return '' if !defined $value || ref $value;
	}

	if ($self->{'config'}->{'parse_vars'}) {
		$value =~ s/ # replace template vars
			\Q$VAR_START_TAG\E
			\s*([\w.-]+)\s*
			\Q$VAR_END_TAG\E
		/ $self->_value($1) /xge;
	}

	return $value;

}


sub _loop {

	my $self  = shift;
	my $ident = shift;
	my $stack = shift;
	my $mode  = shift;
	my ($data, $vars, $skip);
	my $loop_vars  = 0;
	my $loop_count = 0;

	if ($mode == BLOCK) {
	
		$data = $self->_get($ident);
		return 0 unless defined $data;
		
		# no array reference: check the Boolean 
		# context to loop once or skip the block
		unless (ref $data eq 'ARRAY') {
			$data ? $data = [1] : return 0;
			# if statement: no loop vars 
		} else {
			return 0 unless @$data;
			$loop_vars = $self->{'config'}->{'loop_vars'};
		}
	
	} elsif ($mode == LOOP) {

		$data = $self->_get($ident);
		return 0 unless defined $data;
		return 0 unless ref $data eq 'ARRAY';
		return 0 unless @$data;
		$loop_vars = $self->{'config'}->{'loop_vars'};

	} elsif ($mode == IF) {
	
		$data = $self->_get($ident);
		return 0 unless defined $data;
		$data ? $data = [1] : return 0;
	
	} elsif ($mode == UNLESS) {
	
		$data = $self->_get($ident);
		return 0 if $data;
		$data = [1];
	
	} elsif ($mode == ELSE) {
	
		return 0 if $ident;
		$data = [1];
	
	}
	
	foreach $vars (@$data) {
	
		ref $vars eq 'HASH' # add current loop variables
			? (unshift @{ $self->{'vars'} }, $vars)
			: ($skip = 1);

		if ($loop_vars) {
			++$loop_count;
			
			# add loop context variables
			@$data == 1 ? unshift @{ $self->{'loop'} }, { %$FIRST, %$LAST } :
			$loop_count == 1 ? unshift @{ $self->{'loop'} }, $FIRST :
			$loop_count == @$data ? unshift @{ $self->{'loop'} }, $LAST :
				unshift @{ $self->{'loop'} }, $INNER;
			
			# create output
			$self->_output($stack);

			# delete loop context variables
			shift @{ $self->{'loop'} };
			
		} else {
		
			# create output
			$self->_output($stack);
		
		}

		!$skip # delete current loop variables
			? (shift @{ $self->{'vars'} })
			: ($skip = 0);
	}

	return 1;
}


sub _get {
# - returns the variable value from the variable
#   hash (considering the temporary loop variables)

	my $self  = shift;
	my (@ident, $root, $last_key, $skip);
	
	@ident = split /\./, $_[0];
	$last_key = pop @ident;
	
	# check for loop context variables
	return $self->{'loop'}->[0]->{$last_key} if $self->{'config'}->{'loop_vars'}
		&& @ident == 0 && exists $self->{'loop'}->[0]->{$last_key};
	
	# loop values are prepended to the front of the 
	# var array so start with them first
	
	foreach my $hash (@{ $self->{'vars'} }) {

		# speed up normal variable lookup
		return $hash->{$last_key} if @ident == 0 
			&& exists $hash->{$last_key};

		$root = $hash;	# do not change the hash

		foreach my $key (@ident) {
		
			if (ref $root eq 'HASH') {
			# go down the hash structure
			$root = $root->{$key};
			}
			
			else {
			# nothing found
			$skip = 1; last;
			}
			
		}
	
		unless ($skip) { # return if found something
		return $root->{$last_key} if exists $root->{$last_key};
		}
		
		else { # try again
		$skip = 0;
		}

	}

	return undef;

}


sub print {

	my $self = shift;
	my $fh = shift;

	ref $fh eq 'GLOB' || ref \$fh eq 'GLOB'
		? CORE::print $fh $self->{'output'}
		: CORE::print $self->{'output'};

	return 1;

}


sub fetch {
	my $self = shift;
	my $temp = $self->{'output'};
	return \$temp;
}


sub clear {
	my $self = shift;
	$self->clear_vars();
	$self->clear_out();
	return 1;
}


sub clear_vars {
	my $self = shift;
	$self->{'vars'} = [{}];
	$self->block();
	return 1;
}


sub clear_out {
	my $self = shift;
	$self->{'output'} = '';
	return 1;
}


sub clear_cache {
	$CACHE = {};
	return 1;
}


1;



=head1 NAME

HTML::KTemplate - Perl module to process HTML templates.


=head1 SYNOPSIS

B<CGI-Script:>

  #!/usr/bin/perl -w
  use HTML::KTemplate;
  
  $tpl = HTML::KTemplate->new('path/to/templates');
  
  $tpl->assign( TITLE  => 'Template Test Page'    );
  $tpl->assign( TEXT   => 'Some welcome text ...' );
  
  foreach (1 .. 3) {
  
      $tpl->assign( LOOP,
          TEXT => 'Just a test ...',
      );
  
  }
  
  $tpl->process('template.tpl');
  
  $tpl->print();

B<Template:>

  <html>
  <head><title>[% TITLE %]</title>
  <body>
  
  Hello! [% TEXT %]<p>
  
  <!-- BEGIN LOOP -->  
  
  [% TEXT %]<br>
  
  <!-- END LOOP -->
  
  </body>
  </html>


B<Output:>

  Hello! Some welcome text ...
  
  Just a test ...
  Just a test ...
  Just a test ...


=head1 MOTIVATION

Although there are many different template modules at CPAN, I couldn't find any that would meet my expectations. So I created this one with following features:

=over 4

=item *
Template syntax can consist only of variables and blocks.

=item *
Support for multidimensional data structures.

=item *
Everything is very simple and very fast.

=item *
Still there are many advanced options available.

=back

Please email me any comments, suggestions or bug reports to <[e-mail]>.


=head1 VARIABLES

By default, template variables are embedded within C<[% %]> and may contain any alphanumeric characters including the underscore and the hyphen. The values for the variables are assigned with C<assign()>, passed as a hash or a hash reference.

  %hash = (
      VARIABLE => 'Value',
  );
  
  $tpl->assign( %hash );
  $tpl->assign(\%hash );