File Coverage

blib/lib/Text/MicroMason/SafeServerPages.pm

Criterion	Covered	Total	%
statement	3	7	42.8
branch	0	10	0.0
condition			n/a
subroutine	1	3	33.3
pod	0	2	0.0
total	4	22	18.1

package Text::MicroMason::SafeServerPages;

use strict;

our $VERSION = '0.03';

my %block_types = (
	''     => 'perl', # <% perl statements %>
	'='    => 'expr', # <%= perl expression (HTML escaped) %>
	'raw=' => 'expr', # <%= perl expression (raw) %>
	'--'   => 'doc',  # <%-- this text will not appear in the output --%>
	'&'    => 'file', # <%& filename argument %>
);

my $re_eol = "(?:\\r?\\n|\\r|\\z)";
my $re_tag = "args|cleanup|doc|expr|file|init|once|perl|text";

sub lex_token {
	# Blocks in <%word> ...  tags.
	/\G <% ($re_tag) \s*> (.*?) <\/% \1 \s*> $re_eol? /xcogs ? ( $1 => $2 ) :

	# Blocks in <% ... %> tags.
	/\G <% ((?:(?:raw)?=|&)?) (.*?) %> /gcxs ? ( $block_types{$1} => ($1 eq '=') ? "encode_entities(do { $2 }, '<>&\"\\'')" : $2 ) :

	# Blocks in <%-- ... --%> tags.
	/\G <% -- (.*?) -- %> /gcxs ? ( 'doc' => $1 ) :

	# Things that don't match the above.
	/\G ( (?: [^<] | <(?!\/?%) )+ ) /gcxs ? ( 'text' => $1 ) :

	# Lexer error.
	()
}


sub assemble {
	my ($self, @tokens) = @_;

	my $perl_code = $self->NEXT('assemble', @tokens);

	return "do { use HTML::Entities; $perl_code };";
}


1;
__END__