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 : |