File Coverage

blib/lib/Devel/Chitin/OpTree/PMOP.pm
Criterion Covered Total %
statement 65 73 89.0
branch 23 36 63.8
condition 5 9 55.5
subroutine 13 15 86.6
pod 0 4 0.0
total 106 137 77.3


line stmt bran cond sub pod time code
1             package Devel::Chitin::OpTree::PMOP;
2 35     35   188 use base 'Devel::Chitin::OpTree::LISTOP';
  35         57  
  35         3438  
3              
4             our $VERSION = '0.12'; # TRIAL
5              
6 35         2392 use B qw(PMf_CONTINUE PMf_ONCE PMf_GLOBAL PMf_MULTILINE PMf_KEEP PMf_SINGLELINE
7 35     35   193 PMf_EXTENDED PMf_FOLD OPf_KIDS);
  35         48  
8              
9 35     35   174 use strict;
  35         47  
  35         636  
10 35     35   174 use warnings;
  35         73  
  35         18207  
11              
12             sub pp_qr {
13 4     4 0 14 shift->_match_op('qr')
14             }
15              
16             sub pp_match {
17 9     9 0 15 my $self = shift;
18              
19 9         22 $self->_get_bound_variable_for_match
20             . $self->_match_op('m');
21             }
22              
23             sub pp_pushre {
24 0     0 0 0 shift->_match_op('', @_);
25             }
26              
27             sub _get_bound_variable_for_match {
28 15     15   23 my $self = shift;
29              
30 15         32 my($var, $op) = ('', '');
31 15 100       34 if ($self->op->flags & B::OPf_STACKED) {
    100          
32 3         11 $var = $self->first->deparse;
33 3 100       8 $op = $self->parent->op->name eq 'not'
34             ? ' !~ '
35             : ' =~ ';
36             } elsif (my $targ = $self->op->targ) {
37 4         16 $var = $self->_padname_sv($targ)->PV;
38 4         9 $op = ' =~ ';
39              
40             }
41 15         56 $var . $op;
42             }
43              
44             sub pp_subst {
45 5     5 0 9 my $self = shift;
46              
47 5         7 my @children = @{ $self->children };
  5         13  
48              
49             # children always come in this order, though they're not
50             # always present: bound-variable, replacement, regex
51 5         11 my $var = $self->_get_bound_variable_for_match;
52              
53 5 50       9 shift @children if $self->op->flags & B::OPf_STACKED; # bound var was the first child
54              
55 5         9 my $re;
56 5 100 66     17 if ($children[1] and $children[1]->op->name eq 'regcomp') {
57 2         5 $re = $children[1]->deparse(in_regex => 1,
58             regex_x_flag => $self->op->pmflags & PMf_EXTENDED);
59             } else {
60 3         6 $re = $self->op->precomp;
61             }
62              
63 5         14 my $replacement = $children[0]->deparse(skip_quotes => 1, skip_concat => 1);
64              
65 5         10 my $flags = _match_flags($self);
66 5         22 "${var}s/${re}/${replacement}/${flags}";
67             }
68              
69             sub _match_op {
70 19     19   42 my($self, $operator, %params) = @_;
71              
72 19         43 my $re = $self->op->precomp;
73 19 50 66     64 if (defined($re)
      33        
74             and $self->op->name eq 'pushre'
75             and $self->op->flags & B::OPf_SPECIAL
76             ) {
77 0 0       0 return q(' ') if $re eq '\s+';
78 0 0       0 return q('') if $re eq '';
79             }
80              
81 19         47 my $children = $self->children;
82 19         43 foreach my $child ( @$children ) {
83 15 100       86 if ($child->op->name eq 'regcomp') {
84 5         16 $re = $child->deparse(in_regex => 1,
85             regex_x_flag => $self->op->pmflags & PMf_EXTENDED);
86 5         14 last;
87             }
88             }
89              
90 19         47 my $flags = _match_flags($self);
91              
92 19 50       49 my $delimiter = exists($params{delimiter}) ? $params{delimiter} : '/';
93              
94 19         179 join($delimiter, $operator, $re, $flags);
95             }
96              
97             my @MATCH_FLAGS;
98             BEGIN {
99 35     35   184 @MATCH_FLAGS = ( PMf_CONTINUE, 'c',
100             PMf_ONCE, 'o',
101             PMf_GLOBAL, 'g',
102             PMf_FOLD, 'i',
103             PMf_MULTILINE, 'm',
104             PMf_KEEP, 'o',
105             PMf_SINGLELINE, 's',
106             PMf_EXTENDED, 'x',
107             );
108 35 50       604 if ($^V ge v5.10.0) {
109 35         124 push @MATCH_FLAGS, B::RXf_PMf_KEEPCOPY(), 'p';
110             }
111 35 50       263 if ($^V ge v5.22.0) {
112 35         8279 push @MATCH_FLAGS, B::RXf_PMf_NOCAPTURE(), 'n';
113             }
114             }
115              
116             sub _match_flags {
117 24     24   34 my $self = shift;
118              
119 24         49 my $match_flags = $self->op->pmflags;
120 24         41 my $flags = '';
121 24         63 for (my $i = 0; $i < @MATCH_FLAGS; $i += 2) {
122 240 100       469 $flags .= $MATCH_FLAGS[$i+1] if ($match_flags & $MATCH_FLAGS[$i]);
123             }
124 24         46 $flags;
125             }
126              
127             sub _resolve_split_expr {
128 6     6   9 my $self = shift;
129              
130 6         15 return $self->_match_op('', @_);
131             }
132              
133             sub _resolve_split_target {
134 6     6   10 my $self = shift;
135              
136 6         11 my $target = '';
137 6 100       17 if ($self->op->private & B::OPpSPLIT_ASSIGN()) {
138 4 50       11 if ($self->op->flags & B::OPf_STACKED()) {
    50          
139             # target is encoded as the last child op
140 0         0 $target = $self->children->[-1]->deparse;
141              
142             } elsif ($self->op->private & B::OPpSPLIT_LEX()) {
143 4         10 $target = $self->_padname_sv($self->op->pmreplroot)->PV;
144              
145             } else {
146 0         0 my $gv = $self->op->pmreplroot();
147 0 0       0 $gv = $self->_padval_sv($gv) if !ref($gv);
148 0         0 $target = '@' . $self->_gv_name($gv);
149             }
150             }
151 6 100       31 $target .= ' = ' if $target;
152             }
153              
154 0     0     sub _resolve_split_target_pmop { $_[0] }
155              
156             1;
157              
158             __END__