line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Babble::Plugin::DefinedOr; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
70018
|
use Moo; |
|
1
|
|
|
|
|
7266
|
|
|
1
|
|
|
|
|
5
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
sub transform_to_plain { |
6
|
6
|
|
|
6
|
0
|
6681
|
my ($self, $top) = @_; |
7
|
|
|
|
|
|
|
$top->each_match_within(Statement => [ |
8
|
|
|
|
|
|
|
[ before => '(?>(?&PerlPrefixPostfixTerm))' ], |
9
|
|
|
|
|
|
|
[ op => '(?>(?&PerlOWS) //=)' ], '(?>(?&PerlOWS))', |
10
|
|
|
|
|
|
|
[ after => '(?>(?&PerlPrefixPostfixTerm))' ], |
11
|
|
|
|
|
|
|
'(?>(?&PerlOWS))', |
12
|
|
|
|
|
|
|
[ trail => ' |
13
|
|
|
|
|
|
|
(?&PerlStatementModifier)?+ |
14
|
|
|
|
|
|
|
(?>(?&PerlOWS)) |
15
|
|
|
|
|
|
|
(?> ; | (?= \} | \z )) |
16
|
|
|
|
|
|
|
' ], |
17
|
|
|
|
|
|
|
] => sub { |
18
|
2
|
|
|
2
|
|
7
|
my ($m) = @_; |
19
|
2
|
|
|
|
|
12
|
my ($before, $after, $trail) = $m->subtexts(qw(before after trail)); |
20
|
2
|
|
|
|
|
19
|
s/^\s+//, s/\s+$// for ($before, $after); |
21
|
2
|
|
|
|
|
12
|
my $assign = 'defined($_) or $_ = '.$after.' for '.$before; |
22
|
2
|
100
|
|
|
|
12
|
if (length($trail) > 1) { |
23
|
1
|
|
|
|
|
4
|
$assign = 'do { '.$assign.' } ' |
24
|
|
|
|
|
|
|
} |
25
|
2
|
|
|
|
|
14
|
$m->replace_text($assign.$trail); |
26
|
6
|
|
|
|
|
92
|
}); |
27
|
|
|
|
|
|
|
my $tf = sub { |
28
|
4
|
|
|
4
|
|
9
|
my ($m) = @_; |
29
|
4
|
|
|
|
|
30
|
my ($before, $after) = $m->subtexts(qw(before after)); |
30
|
4
|
|
|
|
|
38
|
s/^\s+//, s/\s+$// for ($before, $after); |
31
|
4
|
100
|
|
|
|
86
|
if ($m->submatches->{op}->text =~ /=$/) { |
32
|
2
|
|
|
|
|
39
|
$after = '($_ = '.$after.')'; |
33
|
|
|
|
|
|
|
} |
34
|
4
|
|
|
|
|
80
|
$m->replace_text('(map +(defined($_) ? $_ : '.$after.'), '.$before.')[0]'); |
35
|
6
|
|
|
|
|
95
|
}; |
36
|
6
|
|
|
|
|
55
|
$top->each_match_within(BinaryExpression => [ |
37
|
|
|
|
|
|
|
[ before => '(?>(?&PerlPrefixPostfixTerm))' ], |
38
|
|
|
|
|
|
|
[ op => '(?>(?&PerlOWS) //)' ], '(?>(?&PerlOWS))', |
39
|
|
|
|
|
|
|
[ after => '(?>(?&PerlPrefixPostfixTerm))' ], |
40
|
|
|
|
|
|
|
] => $tf); |
41
|
6
|
|
|
|
|
74
|
$top->each_match_within(Assignment => [ |
42
|
|
|
|
|
|
|
[ before => '(?>(?&PerlConditionalExpression))' ], |
43
|
|
|
|
|
|
|
[ op => '(?>(?&PerlOWS) //=)' ], '(?>(?&PerlOWS))', |
44
|
|
|
|
|
|
|
[ after => '(?>(?&PerlConditionalExpression))' ], |
45
|
|
|
|
|
|
|
] => $tf); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub check_bail_out_early { |
49
|
0
|
|
|
0
|
0
|
|
my ($self, $top) = @_; |
50
|
0
|
|
|
|
|
|
$top->text !~ m, // ,xs; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
1; |
54
|
|
|
|
|
|
|
__END__ |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head1 NAME |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Babble::Plugin::DefinedOr - Plugin for defined-or (//) syntax |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head1 SYNOPSIS |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
Converts usage of the defined-or syntax from |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
$foo // $bar |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
to |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
(map +(defined($_) ? $_ : $bar), $foo)[0] |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head1 SEE ALSO |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
L<E<sol>E<sol> syntax|Syntax::Construct/"//"> |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=cut |