File Coverage

blib/lib/Perl/ToPerl6/Transformer/CompoundStatements/FormatMapGreps.pm
Criterion Covered Total %
statement 25 46 54.3
branch 1 10 10.0
condition 0 27 0.0
subroutine 12 13 92.3
pod 3 5 60.0
total 41 101 40.5


line stmt bran cond sub pod time code
1             package Perl::ToPerl6::Transformer::CompoundStatements::FormatMapGreps;
2              
3 17     17   11407 use 5.006001;
  17         50  
4 17     17   110 use strict;
  17         27  
  17         412  
5 17     17   75 use warnings;
  17         22  
  17         416  
6 17     17   67 use Readonly;
  17         26  
  17         851  
7              
8 17     17   81 use Perl::ToPerl6::Utils qw{ :severities };
  17         21  
  17         919  
9 17     17   1994 use Perl::ToPerl6::Utils::PPI qw{ is_ppi_token_word make_ppi_structure_block };
  17         25  
  17         914  
10              
11 17     17   76 use base 'Perl::ToPerl6::Transformer';
  17         27  
  17         7983  
12              
13             our $VERSION = '0.03';
14              
15             #-----------------------------------------------------------------------------
16              
17             Readonly::Scalar my $DESC => q{Transform 'given()' to 'given ()'};
18             Readonly::Scalar my $EXPL =>
19             q{unless() needs whitespace in order to not be interpreted as a function call};
20              
21             #-----------------------------------------------------------------------------
22              
23             my %map = (
24             map => 1,
25             grep => 1
26             );
27              
28             #-----------------------------------------------------------------------------
29              
30 40     40 0 1394 sub supported_parameters { return () }
31 29     29 1 111 sub default_severity { return $SEVERITY_HIGHEST }
32 25     25 1 87 sub default_themes { return qw(core bugs) }
33             sub applies_to {
34             return sub {
35 61 50   61   689 is_ppi_token_word($_[1], %map) and
36             $_[1]->snext_sibling
37             }
38 4     4 1 21 }
39              
40             #-----------------------------------------------------------------------------
41              
42             sub transform {
43 0     0 0   my ($self, $elem, $doc) = @_;
44              
45             #
46             # XXX This is worrisome, as this test should not need to be done.
47             # XXX The applies_to() method above implies that $elem should have an
48             # XXX snext_sibling by the time it gets here.
49             #
50 0 0         return unless $elem->snext_sibling;
51 0           my $token = $elem->snext_sibling;
52              
53 0 0 0       if ( $token->isa('PPI::Structure::Block') and
      0        
      0        
      0        
54             $token->start and
55             $token->start eq '{' and
56             $token->finish and
57             $token->finish eq '}' ) {
58 0 0 0       return if $token->snext_sibling and
      0        
59             $token->snext_sibling->isa('PPI::Token::Operator') and
60             $token->snext_sibling->content eq ',';
61 0           my $comma = PPI::Token::Operator->new(',');
62 0           $token->insert_after( $comma );
63             }
64             else {
65 0           my $point = $token;
66              
67 0           my $new_block = make_ppi_structure_block;
68 0           my $new_statement = PPI::Statement->new;
69 0           $new_block->add_element($new_statement);
70              
71 0   0       while ( $token and $token->next_sibling ) {
72 0 0         last if $token->content eq ',';
73 0           $new_statement->add_element($token->clone);
74 0           $token = $token->next_sibling;
75             }
76              
77 0           $point->insert_before($new_block);
78 0   0       while ( $point and
      0        
79             not ( $point->isa('PPI::Token::Operator') and
80             $point->content eq ',' ) ) {
81 0           my $temp = $point->next_sibling;
82 0           $point->remove;
83 0           $point = $temp;
84             }
85             }
86              
87 0           return $self->transformation( $DESC, $EXPL, $elem );
88             }
89              
90             1;
91              
92             #-----------------------------------------------------------------------------
93              
94             __END__
95              
96             =pod
97              
98             =head1 NAME
99              
100             Perl::ToPerl6::Transformer::CompoundStatements::FormatMapGreps - Format map{}, grep{}
101              
102              
103             =head1 AFFILIATION
104              
105             This Transformer is part of the core L<Perl::ToPerl6|Perl::ToPerl6>
106             distribution.
107              
108              
109             =head1 DESCRIPTION
110              
111             Perl6 unifies C<map{}> and C<grep{}> with the rest of the function calls, in that the first argument must be a block, and the arguments must be separated with commas. This transformer adds the block where needed, and inserts the comma as required:
112              
113             map {$_++} @x; --> map {$_++}, @x;
114             map /x/ @x; --> map {/x/}, @x;
115             grep {$_++} @x; --> grep {$_++}, @x;
116             grep /x/ @x; --> grep {/x/}, @x;
117              
118             =head1 CONFIGURATION
119              
120             This Transformer is not configurable except for the standard options.
121              
122             =head1 AUTHOR
123              
124             Jeffrey Goff <drforr@pobox.com>
125              
126             =head1 COPYRIGHT
127              
128             Copyright (c) 2015 Jeffrey Goff
129              
130             This program is free software; you can redistribute it and/or modify
131             it under the same terms as Perl itself.
132              
133             =cut
134              
135             ##############################################################################
136             # Local Variables:
137             # mode: cperl
138             # cperl-indent-level: 4
139             # fill-column: 78
140             # indent-tabs-mode: nil
141             # c-indentation-style: bsd
142             # End:
143             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :