File Coverage

blib/lib/Perl/ToPerl6/Transformer/Builtins/FormatPrint.pm
Criterion Covered Total %
statement 48 59 81.3
branch 7 18 38.8
condition 6 27 22.2
subroutine 16 16 100.0
pod 3 6 50.0
total 80 126 63.4


line stmt bran cond sub pod time code
1             package Perl::ToPerl6::Transformer::Builtins::FormatPrint;
2              
3 17     17   11741 use 5.006001;
  17         52  
4 17     17   81 use strict;
  17         26  
  17         356  
5 17     17   68 use warnings;
  17         26  
  17         420  
6 17     17   67 use Readonly;
  17         21  
  17         843  
7              
8 17     17   84 use Perl::ToPerl6::Utils qw{ :characters :severities };
  17         33  
  17         877  
9 17     17   4155 use Perl::ToPerl6::Utils::PPI qw{ is_ppi_token_word make_ppi_structure_list };
  17         30  
  17         990  
10              
11 17     17   79 use base 'Perl::ToPerl6::Transformer';
  17         27  
  17         10883  
12              
13             our $VERSION = '0.03';
14              
15             #-----------------------------------------------------------------------------
16              
17             Readonly::Scalar my $DESC => q{Format 'print FOO $text;' to 'FOO.print($text)'};
18             Readonly::Scalar my $EXPL => q{Format 'print FOO $text;' to 'FOO.print($text)'};
19              
20             #-----------------------------------------------------------------------------
21              
22             my %map = (
23             print => 1
24             );
25              
26             #-----------------------------------------------------------------------------
27              
28             # Our first usage of the topological sorting.
29             #
30             # The change 'print FOO "stuff"' --> 'FOO.print("stuff")' rewrites the Perl5
31             # code to Perl6, so it has to be run *after* the Perl5-Perl6 operator
32             # conversion has taken place.
33             #
34             # It might even be better to rephrase this in terms of:
35             #
36             # "Run this test only after resetting the content of PPI::Token::Operators"
37             # but that feel dangerous and fragile.
38             #
39              
40 33     33 0 110 sub run_after { 'Operators::FormatOperators' }
41              
42 40     40 0 1892 sub supported_parameters { return () }
43 31     31 1 126 sub default_severity { return $SEVERITY_HIGHEST }
44 25     25 1 80 sub default_themes { return qw(core bugs) }
45             sub applies_to {
46             return sub {
47 61 100 33 61   915 is_ppi_token_word($_[1], %map) and
48             not ( $_[1]->snext_sibling
49             ->snext_sibling->isa('PPI::Token::Operator') and
50             $_[1]->snext_sibling
51             ->snext_sibling->content eq ',' )
52             }
53 4     4 1 25 }
54              
55             #-----------------------------------------------------------------------------
56              
57             my %postfix_modifier = (
58             if => 1,
59             unless => 1,
60             while => 1,
61             until => 1,
62             for => 1,
63             foreach => 1
64             );
65              
66             my %operator = (
67             and => 1,
68             or => 1,
69             xor => 1,
70             '&&' => 1,
71             '||' => 1,
72             '^^' => 1
73             );
74              
75             sub _is_end_of_print_expression {
76 3     3   7 my $elem = shift;
77 3 50 33     15 return 1 if $elem->isa('PPI::Token::Structure') and
78             $elem->content eq ';';
79             return 1 if $elem->isa('PPI::Token::Word') and
80 0 0 0     0 exists $postfix_modifier{$elem->content};
81             return 1 if $elem->isa('PPI::Token::Operator') and
82 0 0 0     0 exists $operator{$elem->content};
83 0         0 return;
84             }
85              
86             sub _is_almost_end_of_print_expression {
87 3     3   3 my $elem = shift;
88 3 50 0     8 return 1 if _is_end_of_print_expression($elem) or
      33        
89             $elem->isa('PPI::Token::Whitespace') and
90             _is_end_of_print_expression($elem->snext_sibling);
91 0         0 return;
92             }
93              
94             sub transform {
95 3     3 0 5 my ($self, $elem, $doc) = @_;
96 3 50 33     6 return unless $elem->snext_sibling and
97             $elem->snext_sibling->snext_sibling;
98              
99 3         111 my $token = $elem->snext_sibling->snext_sibling;
100              
101 3         54 my $point = $token;
102              
103 3         12 my $new_list = make_ppi_structure_list;
104 3         12 my $new_statement = PPI::Statement->new;
105 3         36 $new_list->add_element($new_statement);
106              
107 3   33     60 while ( $token and $token->next_sibling ) {
108 0 0       0 last if _is_almost_end_of_print_expression($token);
109 0         0 $new_statement->add_element($token->clone);
110 0         0 $token = $token->next_sibling;
111             }
112              
113 3         67 $point->insert_before($new_list);
114 3   33     152 while ( $point and
115             not _is_almost_end_of_print_expression($point) ) {
116 0         0 my $temp = $point->next_sibling;
117 0         0 $point->remove;
118 0         0 $point = $temp;
119             }
120              
121 3 50       34 if ( $elem->next_sibling->isa('PPI::Token::Whitespace') ) {
122 3         38 $elem->next_sibling->remove;
123             }
124 3         112 my $filehandle_variable = $elem->snext_sibling->clone;
125 3         87 $elem->snext_sibling->remove;
126 3 50       89 if ( $elem->next_sibling->isa('PPI::Token::Whitespace') ) {
127 0         0 $elem->next_sibling->remove;
128             }
129 3         51 $elem->insert_before($filehandle_variable);
130 3         80 $elem->insert_before(
131             PPI::Token::Operator->new('.')
132             );
133             #print "[".$doc->content."]\n";
134              
135 3         174 return $self->transformation( $DESC, $EXPL, $elem );
136             }
137              
138             1;
139              
140             #-----------------------------------------------------------------------------
141              
142             __END__
143              
144             =pod
145              
146             =head1 NAME
147              
148             Perl::ToPerl6::Transformer::Builtins::FormatPrint - Format 'print $fh "expr"'
149              
150              
151             =head1 AFFILIATION
152              
153             This Transformer is part of the core L<Perl::ToPerl6|Perl::ToPerl6>
154             distribution.
155              
156              
157             =head1 DESCRIPTION
158              
159             Perl6 now uses a C<print> method on filehandles as opposed to the old C<print $fh>:
160              
161             print $fh $x --> $fh.print($x)
162              
163             Transforms variables outside of comments, heredocs, strings and POD.
164              
165             =head1 CONFIGURATION
166              
167             This Transformer is not configurable except for the standard options.
168              
169             =head1 AUTHOR
170              
171             Jeffrey Goff <drforr@pobox.com>
172              
173             =head1 COPYRIGHT
174              
175             Copyright (c) 2015 Jeffrey Goff
176              
177             This program is free software; you can redistribute it and/or modify
178             it under the same terms as Perl itself.
179              
180             =cut
181              
182             ##############################################################################
183             # Local Variables:
184             # mode: cperl
185             # cperl-indent-level: 4
186             # fill-column: 78
187             # indent-tabs-mode: nil
188             # c-indentation-style: bsd
189             # End:
190             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :