File Coverage

blib/lib/MasonX/Lexer/MSP.pm

Criterion	Covered	Total	%
statement	57	66	86.3
branch	40	50	80.0
condition	3	9	33.3
subroutine	10	10	100.0
pod	0	5	0.0
total	110	140	78.5

package MasonX::Lexer::MSP;

# Written by John Williams.  Most code is plagurized from Lexer.pm, which is:
# Copyright (c) 1998-2004 by Jonathan Swartz. All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

use strict;
use warnings;
our $VERSION = '0.11';
use base qw(HTML::Mason::Lexer);

use HTML::Mason::Exceptions( abbr => [qw(param_error syntax_error error)] );

use Params::Validate qw(:all);
Params::Validate::validation_options( on_fail => sub { param_error join '', @_ } );


__PACKAGE__->valid_params (
	perl_lines	=> { parse => 'boolean', type => BOOLEAN, default => 0,
				descr => "Allow perl-lines to be used", },
	);


sub start
{
    my $self = shift;

    my $end;
    while ( defined $self->{current}{pos} ?
	    $self->{current}{pos} < length $self->{current}{comp_source} :
	    1 )
    {
	last if $end = $self->match_end;

	$self->match_block && next;

	$self->match_named_block && next;

	$self->match_substitute && next;

	$self->match_code_tag && next;

	$self->match_comment_tag && next;

	$self->match_comp_call && next;

	$self->match_perl_line && next;

	$self->match_comp_content_call && next;

	$self->match_comp_content_call_end && next;

	$self->match_text && next;

	if ( ( $self->{current}{in_def} || $self->{current}{in_method} ) &&
	     $self->{current}{comp_source} =~ /\G\z/ )
	{
	    my $type = $self->{current}{in_def} ? 'def' : 'method';
	    $self->throw_syntax_error("Missing closing  tag");
	}

	# We should never get here - if we do, we're in an infinite loop.
	$self->throw_syntax_error("Infinite parsing loop encountered - Lexer bug?");
    }

    if ( $self->{current}{in_def} || $self->{current}{in_method} )
    {
	my $type = $self->{current}{in_def} ? 'def' : 'method';
	unless ( $end =~ m,\n?,i )
	{
	    my $block_name = $self->{current}{"in_$type"};
	    $self->throw_syntax_error("No  tag for <%$type $block_name> block");
	}
    }
}


sub match_substitute
{
    my $self = shift;

    if ( $self->{current}{comp_source} =~ /\G<%=/gcs )
    {
	if ( $self->{current}{comp_source} =~ /\G(.+?)(\s*\|\s*([\w\s,]+)?\s*)?%>/igcs )
	{
	    my ($sub, $escape) = ($1, $3);
	    $self->{current}{compiler}->substitution( substitution => $sub,
						      escape => $escape );

	    # Add it in just to count lines
	    $sub .= $2 if $2;
	    $self->{current}{lines} += $sub =~ tr/\n/\n/;

	    return 1;
	}
	else
	{
	    $self->throw_syntax_error("'<%=' without matching '%>'");
	}
    }
}

# match <% code %>
# '<%' should not be immediately followed by '=', '|', '&', or '-'
# '=' is substitution, '-' is comments,
# '|' and '&' might be used for components calls in the future
# Actually a space is preferred: i.e. '<% '
sub match_code_tag
{
    my $self = shift;

    if ( $self->{current}{comp_source} =~ /\G<%(?![=|&-])/gcs )
    {
	if ( $self->{current}{comp_source} =~ /\G(.+?)%>/gcs )
	{
	    my $code = $1;
	    $self->{current}{compiler}->raw_block( block_type => 'perl',
						   block => $code );

	    # count lines
	    $self->{current}{lines} += $code =~ tr/\n/\n/;

	    return 1;
	}
	else
	{
	    $self->throw_syntax_error("'<%' without matching '%>'");
	}
    }
}

sub match_comment_tag
{
	my $self = shift;

	if ( $self->{current}{comp_source} =~ /\G<%--/gcs )
	{
		if ( $self->{current}{comp_source} =~ /\G(.*?)--%>/gcs )
		{
			my $comment = $1;
			$self->{current}{compiler}->doc_block( block_type => 'doc',
							block => $comment );

			$self->{current}{lines} += $comment =~ tr/\n/\n/;

			return 1;
		}
		else
		{
			$self->throw_syntax_error("'<%--' without matching '--%>'");
		}
	}
}


sub match_perl_line
{
    my $self = shift;

    return 0 unless $self->{perl_lines};

    return $self->SUPER::match_perl_line(@_);
}


1;

__END__