File Coverage

blib/lib/Babble/Plugin/DefinedOr.pm
Criterion Covered Total %
statement 21 23 91.3
branch 4 4 100.0
condition n/a
subroutine 4 5 80.0
pod 0 2 0.0
total 29 34 85.2


line stmt bran cond sub pod time code
1             package Babble::Plugin::DefinedOr;
2              
3 1     1   69392 use Moo;
  1         7228  
  1         5  
4              
5             sub transform_to_plain {
6 6     6 0 6440 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   8 my ($m) = @_;
19 2         11 my ($before, $after, $trail) = $m->subtexts(qw(before after trail));
20 2         24 s/^\s+//, s/\s+$// for ($before, $after);
21 2         10 my $assign = 'defined($_) or $_ = '.$after.' for '.$before;
22 2 100       11 if (length($trail) > 1) {
23 1         3 $assign = 'do { '.$assign.' } '
24             }
25 2         16 $m->replace_text($assign.$trail);
26 6         91 });
27             my $tf = sub {
28 4     4   10 my ($m) = @_;
29 4         21 my ($before, $after) = $m->subtexts(qw(before after));
30 4         38 s/^\s+//, s/\s+$// for ($before, $after);
31 4 100       85 if ($m->submatches->{op}->text =~ /=$/) {
32 2         41 $after = '($_ = '.$after.')';
33             }
34 4         56 $m->replace_text('(map +(defined($_) ? $_ : '.$after.'), '.$before.')[0]');
35 6         104 };
36 6         55 $top->each_match_within(BinaryExpression => [
37             [ before => '(?>(?&PerlPrefixPostfixTerm))' ],
38             [ op => '(?>(?&PerlOWS) //)' ], '(?>(?&PerlOWS))',
39             [ after => '(?>(?&PerlPrefixPostfixTerm))' ],
40             ] => $tf);
41 6         56 $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