Slide 66
Slide 66 text
sub _parse_predicate_in_handler
{ my( $flag, $score)= @_[1..2];
$_[0]=~ s{( ($REG_STRING) # strings
|\@($REG_TAG_NAME)(\s* $REG_MATCH \s* $REG_REGEXP) # @att and regexp
|\@($REG_TAG_NAME)(?=\s*(?:[><=!])) # @att followed by a comparison operator
|\@($REG_TAG_NAME) # @att (not followed by a comparison operator)
|=~|!~ # matching operators
|([><]=?|=|!=)(?=\s*[\d+-]) # test before a number
|([><]=?|=|!=) # test, other cases
|($REG_FUNCTION) # no arg functions
# this bit is a mess, but it is the only solution with this half-baked parser
|(string\(\s*$REG_NAME\s*\)\s*$REG_MATCH\s*$REG_REGEXP) # string( child)=~ /regexp/
|(string\(\s*$REG_NAME\s*\)\s*$REG_COMP\s*$REG_STRING) # string( child) = "value" (or other test)
|(string\(\s*$REG_NAME\s*\)\s*$REG_COMP\s*$REG_NUMBER) # string( child) = nb (or other test)
|(and|or)
# |($REG_NAME(?=\s*(and|or|$))) # nested tag name (needs to be after all other unquoted strings)
|($REG_TAG_IN_PREDICATE) # nested tag name (needs to be after all other unquoted strings)
)}
{ my( $token, $str, $att_re_name, $att_re_regexp, $att, $bare_att, $num_test, $alpha_test, $func, $str_regexp, $str_test_alpha, $str_test_num, $and_or, $tag)
= ( $1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13, $14);
$score->{predicates}++;
# store tests on text (they are not always allowed)
if( $func || $str_regexp || $str_test_num || $str_test_alpha ) { $flag->{test_on_text}= 1; }
if( defined $str) { $token }
elsif( $tag) { qq{(\$elt->{'$ST_ELT'} && \$elt->{'$ST_ELT'}->has_child( '$tag'))} }
elsif( $att) { $att=~ m{^#} ? qq{ (\$elt->{'$ST_ELT'} && \$elt->{'$ST_ELT'}->{att}->{'$att'})}
: qq{\$elt->{'$att'}}
}
elsif( $att_re_name) { $att_re_name=~ m{^#} ? qq{ (\$elt->{'$ST_ELT'} && \$elt->{'$ST_ELT'}->{att}->{'$att_re_name'}$att_re_regexp)}
: qq{\$elt->{'$att_re_name'}$att_re_regexp}
}
# for some reason Devel::Cover flags the following lines as not tested. They are though.
elsif( $bare_att) { $bare_att=~ m{^#} ? qq{(\$elt->{'$ST_ELT'} && defined(\$elt->{'$ST_ELT'}->{att}->{'$bare_att'}))}
: qq{defined( \$elt->{'$bare_att'})}
}
elsif( $num_test && ($num_test eq '=') ) { "==" } # others tests are unchanged
elsif( $alpha_test) { $PERL_ALPHA_TEST{$alpha_test} }
elsif( $func && $func=~ m{^string})
{ "\$elt->{'$ST_ELT'}->text"; }
elsif( $str_regexp && $str_regexp =~ m{string\(\s*($REG_TAG_NAME)\s*\)\s*($REG_MATCH)\s*($REG_REGEXP)})
{ "defined( _first_n { \$_->text $2 $3 } 1, \$elt->{'$ST_ELT'}->_children( '$1'))"; }
elsif( $str_test_alpha && $str_test_alpha =~ m{string\(\s*($REG_TAG_NAME)\s*\)\s*($REG_COMP)\s*($REG_STRING)})
{ my( $tag, $op, $str)= ($1, $2, $3);
$str=~ s{(?<=.)'(?=.)}{\\'}g; # escape a quote within the string
$str=~ s{^"}{'};
$str=~ s{"$}{'};
"defined( _first_n { \$_->text $PERL_ALPHA_TEST{$op} $str } 1, \$elt->{'$ST_ELT'}->children( '$tag'))"; }
elsif( $str_test_num && $str_test_num =~ m{string\(\s*($REG_TAG_NAME)\s*\)\s*($REG_COMP)\s*($REG_NUMBER)})
{ my $test= ($2 eq '=') ? '==' : $2;
"defined( _first_n { \$_->text $test $3 } 1, \$elt->{'$ST_ELT'}->children( '$1'))";
}
elsif( $and_or) { $score->{tests}++; $and_or eq 'and' ? '&&' : '||' ; }
else { $token; }
}gexs;
}
Twig.pm, L1765-1823