line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::MicroMason::HTMLMason; |
2
|
|
|
|
|
|
|
|
3
|
36
|
|
|
36
|
|
15537
|
use strict; |
|
36
|
|
|
|
|
68
|
|
|
36
|
|
|
|
|
11326
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
###################################################################### |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
my $re_eol = "(?:\\r\\n|\\r|\\n|\\z)"; |
8
|
|
|
|
|
|
|
my $re_sol = "(?:\\A|(?<=\\r|\\n) )"; |
9
|
|
|
|
|
|
|
my $re_tag = "perl|args|once|init|cleanup|doc|text|expr|file"; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# ( $type, $value ) = $mason->lex_token(); |
12
|
|
|
|
|
|
|
sub lex_token { |
13
|
|
|
|
|
|
|
# Blocks in <%word> ... <%word> tags. |
14
|
964
|
50
|
|
964
|
1
|
11693
|
/\G \<\%($re_tag)\> (.*?) \<\/\%\1\> $re_eol? /xcogs ? ( $1 => $2 ) : |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Blocks in <% ... %> tags. |
17
|
|
|
|
|
|
|
/\G \<\% ( .*? ) \%\> /xcogs ? ( 'expr' => $1 ) : |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Blocks in <& ... &> tags. |
20
|
|
|
|
|
|
|
/\G \<\& ( .*? ) \&\> /xcogs ? ( 'file' => $1 ) : |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# Lines begining with % |
23
|
|
|
|
|
|
|
/\G $re_sol \% ( [^\n\r]* ) $re_eol /xcogs ? ( 'perl' => $1 ) : |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Things that don't match the above |
26
|
|
|
|
|
|
|
/\G ( (?: [^\<\r\n%]+ | \<(?!\%|\&) | (?<=[^\r\n\<])% | |
27
|
|
|
|
|
|
|
$re_eol (?:\z|[^\r\n\%\<]|(?=\r\n|\r|\n|\%)|\<[^\%\&]|(?=\<[\%\&])) |
28
|
|
|
|
|
|
|
)+ (?: $re_eol +(?:\z|(?=\%|\<\[\%\&])) )? |
29
|
|
|
|
|
|
|
) /xcogs ? ( 'text' => $1 ) : |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Lexer error |
32
|
|
|
|
|
|
|
() |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
###################################################################### |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Text elements used for subroutine assembly |
38
|
|
|
|
|
|
|
sub assembler_rules { |
39
|
296
|
|
|
296
|
1
|
1713
|
my $self = shift; |
40
|
296
|
|
|
|
|
837
|
$self->NEXT('assembler_rules'), |
41
|
|
|
|
|
|
|
template => [ qw( @once $sub_start $init_errs $init_output $init_args |
42
|
|
|
|
|
|
|
@init @perl !@cleanup $return_output $sub_end -@doc ) ] |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub assemble_args { |
46
|
25
|
|
|
25
|
1
|
40
|
my ( $self, $token ) = @_; |
47
|
25
|
|
|
|
|
108
|
$token =~ s/^\s*([\$\@\%])(\w+) (?:\s* => \s* ([^\r\n]+))?/ |
48
|
36
|
100
|
|
|
|
108
|
my $argvar = ($1 eq '$') ? "\$ARGS{$2}" : "$1\{ \$ARGS{$2} }"; |
49
|
36
|
100
|
|
|
|
172
|
"my $1$2 = exists \$ARGS{$2} ? $argvar : " . |
50
|
|
|
|
|
|
|
( defined($3) ? "($argvar = $3\n)" : |
51
|
|
|
|
|
|
|
qq{Carp::croak("no value sent for required parameter '$2'")} ) . |
52
|
|
|
|
|
|
|
";"/gexm; |
53
|
25
|
|
|
|
|
95
|
return ( 'init' => '($#_ % 2) or Carp::croak("Odd number of parameters passed to sub expecting name/value pairs"); ' . "\n" . $token ); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
###################################################################### |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
1; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
__END__ |