line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Babble::Plugin::PostfixDeref; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
72690
|
use Moo; |
|
1
|
|
|
|
|
7277
|
|
|
1
|
|
|
|
|
5
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
my $term_derefable = q{ |
6
|
|
|
|
|
|
|
# Copied from <PerlTerm> rule in PPR::X@0.001002 |
7
|
|
|
|
|
|
|
# The remaining alternatives can all take postfix dereferencers... |
8
|
|
|
|
|
|
|
# ... |
9
|
|
|
|
|
|
|
(?: |
10
|
|
|
|
|
|
|
(?= \$ ) (?&PerlScalarAccess) |
11
|
|
|
|
|
|
|
| |
12
|
|
|
|
|
|
|
(?= \@ ) (?&PerlArrayAccess) |
13
|
|
|
|
|
|
|
| |
14
|
|
|
|
|
|
|
(?= % ) (?&PerlHashAccess) |
15
|
|
|
|
|
|
|
| |
16
|
|
|
|
|
|
|
(?&PerlAnonymousSubroutine) |
17
|
|
|
|
|
|
|
| |
18
|
|
|
|
|
|
|
(?>(?&PerlNullaryBuiltinFunction)) (?! (?>(?&PerlOWS)) \( ) |
19
|
|
|
|
|
|
|
| |
20
|
|
|
|
|
|
|
(?&PerlDoBlock) | (?&PerlEvalBlock) |
21
|
|
|
|
|
|
|
| |
22
|
|
|
|
|
|
|
(?&PerlCall) |
23
|
|
|
|
|
|
|
| |
24
|
|
|
|
|
|
|
(?&PerlVariableDeclaration) |
25
|
|
|
|
|
|
|
| |
26
|
|
|
|
|
|
|
(?&PerlTypeglob) |
27
|
|
|
|
|
|
|
| |
28
|
|
|
|
|
|
|
(?>(?&PerlParenthesesList)) |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# Can optionally do a [...] lookup straight after the parens, |
31
|
|
|
|
|
|
|
# followd by any number of other look-ups |
32
|
|
|
|
|
|
|
(?: |
33
|
|
|
|
|
|
|
(?>(?&PerlOWS)) (?&PerlArrayIndexer) |
34
|
|
|
|
|
|
|
(?: |
35
|
|
|
|
|
|
|
(?>(?&PerlOWS)) |
36
|
|
|
|
|
|
|
(?> |
37
|
|
|
|
|
|
|
(?&PerlArrayIndexer) |
38
|
|
|
|
|
|
|
| (?&PerlHashIndexer) |
39
|
|
|
|
|
|
|
| (?&PerlParenthesesList) |
40
|
|
|
|
|
|
|
) |
41
|
|
|
|
|
|
|
)*+ |
42
|
|
|
|
|
|
|
)?+ |
43
|
|
|
|
|
|
|
| |
44
|
|
|
|
|
|
|
(?&PerlAnonymousArray) |
45
|
|
|
|
|
|
|
| |
46
|
|
|
|
|
|
|
(?&PerlAnonymousHash) |
47
|
|
|
|
|
|
|
| |
48
|
|
|
|
|
|
|
(?&PerlDiamondOperator) |
49
|
|
|
|
|
|
|
| |
50
|
|
|
|
|
|
|
(?&PerlContextualMatch) |
51
|
|
|
|
|
|
|
| |
52
|
|
|
|
|
|
|
(?&PerlQuotelikeS) |
53
|
|
|
|
|
|
|
| |
54
|
|
|
|
|
|
|
(?&PerlQuotelikeTR) |
55
|
|
|
|
|
|
|
| |
56
|
|
|
|
|
|
|
(?&PerlQuotelikeQX) |
57
|
|
|
|
|
|
|
| |
58
|
|
|
|
|
|
|
(?&PerlLiteral) |
59
|
|
|
|
|
|
|
) |
60
|
|
|
|
|
|
|
}; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my $scalarnospace_post = q{ |
63
|
|
|
|
|
|
|
# Copied from <PerlScalarAccessNoSpace> rule in PPR::X@0.001002 |
64
|
|
|
|
|
|
|
# Then any nuber of arrowed accesses |
65
|
|
|
|
|
|
|
# (this is an inlined subset of (?&PerlTermPostfixDereference))... |
66
|
|
|
|
|
|
|
(?: |
67
|
|
|
|
|
|
|
-> |
68
|
|
|
|
|
|
|
(?> |
69
|
|
|
|
|
|
|
# A series of simple brackets can omit interstitial arrows... |
70
|
|
|
|
|
|
|
(?: (?&PerlArrayIndexer) |
71
|
|
|
|
|
|
|
| (?&PerlHashIndexer) |
72
|
|
|
|
|
|
|
)++ |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
| # An array or hash slice... |
75
|
|
|
|
|
|
|
\@ (?> (?>(?&PerlArrayIndexer)) | (?>(?&PerlHashIndexer)) ) |
76
|
|
|
|
|
|
|
) |
77
|
|
|
|
|
|
|
)*+ |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Followed by at most one of these terminal arrowed dereferences... |
80
|
|
|
|
|
|
|
(?: |
81
|
|
|
|
|
|
|
-> |
82
|
|
|
|
|
|
|
(?> |
83
|
|
|
|
|
|
|
# An array or scalar deref... |
84
|
|
|
|
|
|
|
[\@\$] \* |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
| # An array count deref... |
87
|
|
|
|
|
|
|
\$ \# \* |
88
|
|
|
|
|
|
|
) |
89
|
|
|
|
|
|
|
)?+ |
90
|
|
|
|
|
|
|
}; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub transform_to_plain { |
93
|
21
|
|
|
21
|
0
|
24023
|
my ($self, $top) = @_; |
94
|
21
|
|
|
|
|
78
|
for my $argument (qw(postderef postderef_qq)) { |
95
|
42
|
|
|
|
|
267
|
$top->remove_use_argument(experimental => $argument); |
96
|
42
|
|
|
|
|
559
|
$top->remove_use_argument(feature => $argument); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
my $tf = sub { |
99
|
23
|
|
|
23
|
|
82
|
my ($m, $in_quotelike) = @_; |
100
|
23
|
|
66
|
|
|
150
|
my $interpolate = defined $in_quotelike && $in_quotelike; |
101
|
23
|
|
|
|
|
153
|
my ($term, $postfix) = $m->subtexts(qw(term postfix)); |
102
|
|
|
|
|
|
|
#warn "Term: $term"; warn "Postfix: $postfix"; |
103
|
23
|
|
|
|
|
510
|
my $grammar = $m->grammar_regexp; |
104
|
23
|
|
|
|
|
1071349
|
my $strip_re = qr{ |
105
|
|
|
|
|
|
|
( (?>(?&PerlOWS)) -> (?>(?&PerlOWS)) |
106
|
|
|
|
|
|
|
(?> |
107
|
|
|
|
|
|
|
\$\#\* |
108
|
|
|
|
|
|
|
| \$\* |
109
|
|
|
|
|
|
|
| (?> (?&PerlQualifiedIdentifier) | (?&PerlVariableScalar) ) |
110
|
|
|
|
|
|
|
(?: (?>(?&PerlOWS)) (?&PerlParenthesesList) )?+ |
111
|
|
|
|
|
|
|
| (?: |
112
|
|
|
|
|
|
|
(?>(?&PerlOWS)) |
113
|
|
|
|
|
|
|
(?> (?&PerlParenthesesList) | (?&PerlArrayIndexer) | (?&PerlHashIndexer) ) |
114
|
|
|
|
|
|
|
)++ |
115
|
|
|
|
|
|
|
) |
116
|
|
|
|
|
|
|
) |
117
|
|
|
|
|
|
|
${grammar} |
118
|
|
|
|
|
|
|
}x; |
119
|
23
|
|
|
|
|
1094694
|
while ($postfix =~ s/^${strip_re}//) { |
120
|
11
|
|
|
|
|
2028
|
my $stripped = $1; |
121
|
11
|
100
|
|
|
|
115
|
if ($stripped =~ /(\$\#?)\*$/) { |
122
|
5
|
|
|
|
|
17
|
my $sigil = $1; |
123
|
5
|
|
|
|
|
31
|
$term = $sigil.'{'.$term.'}'; |
124
|
5
|
100
|
|
|
|
153007
|
if( $interpolate ) { |
125
|
2
|
|
|
|
|
86101
|
$term = "\@{[ $term ]}"; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
} else { |
128
|
6
|
|
|
|
|
294204
|
$term .= $stripped; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
} |
131
|
23
|
100
|
|
|
|
3886
|
if ($postfix) { |
132
|
12
|
|
|
|
|
194
|
my ($sigil, $rest) = ($postfix =~ /^\s*->\s*([\@%])(.*)$/); |
133
|
12
|
100
|
|
|
|
95
|
$rest = '' if $rest eq '*'; |
134
|
12
|
|
|
|
|
78
|
$term = $sigil.'{'.$term.'}'.$rest; |
135
|
12
|
100
|
|
|
|
55
|
if( $interpolate ) { |
136
|
|
|
|
|
|
|
# NOTE This can be interpolated safely |
137
|
|
|
|
|
|
|
# because: |
138
|
|
|
|
|
|
|
# 1. The delimiters are balanced so use inside of |
139
|
|
|
|
|
|
|
# `qq{ ... }` or `qq[ ... ]` is safe. |
140
|
|
|
|
|
|
|
# 2. The contents of $term can only contain expressions that |
141
|
|
|
|
|
|
|
# have `$` and `@` sigils, so any expression contained in |
142
|
|
|
|
|
|
|
# $term which is used within `qq@ ... @` will not have the |
143
|
|
|
|
|
|
|
# `@` sigil (same with the `qq$ ... $` and `$` sigil). |
144
|
3
|
|
|
|
|
15
|
$term = "\@{[ $term ]}"; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
23
|
|
|
|
|
1244
|
$m->submatches->{term}->replace_text($term); |
148
|
23
|
|
|
|
|
450
|
$m->submatches->{postfix}->replace_text(''); |
149
|
21
|
|
|
|
|
269
|
}; |
150
|
21
|
|
|
|
|
689
|
$top->each_match_within(Term => [ |
151
|
|
|
|
|
|
|
[ term => "(?> $term_derefable )" ], |
152
|
|
|
|
|
|
|
[ postfix => '(?&PerlTermPostfixDereference)' ], |
153
|
|
|
|
|
|
|
] => $tf); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# NOTE ScalarAccessNoSpace is used within the |
156
|
|
|
|
|
|
|
# ScalarAccessNoSpaceNoArrow rule, but any such |
157
|
|
|
|
|
|
|
# matches here via that rule would be invalid input |
158
|
|
|
|
|
|
|
# to begin with. |
159
|
|
|
|
|
|
|
$top->each_match_within(ScalarAccessNoSpace => [ |
160
|
|
|
|
|
|
|
[ term => q{ |
161
|
|
|
|
|
|
|
(?>(?&PerlVariableScalarNoSpace)) |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# Optional arrowless access(es) to begin... |
164
|
|
|
|
|
|
|
(?: (?&PerlArrayIndexer) | (?&PerlHashIndexer) )*+ |
165
|
|
|
|
|
|
|
} ], |
166
|
|
|
|
|
|
|
[ postfix => $scalarnospace_post ], |
167
|
21
|
|
|
10
|
|
338
|
] => sub { $tf->(shift, 1) }); |
|
10
|
|
|
|
|
42
|
|
168
|
|
|
|
|
|
|
# NOTE ArrayAccessNoSpace also needs to implemented. |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
1; |
172
|
|
|
|
|
|
|
__END__ |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head1 NAME |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
Babble::Plugin::PostfixDeref - Plugin for postfix dereferencing |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 SYNOPSIS |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Converts usage of the postderef syntax from |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
$foo->@* |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
to |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
@{$foo} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head1 SEE ALSO |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
L<postderef feature|feature/"The 'postderef' and 'postderef_qq' features"> |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=cut |