line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perl::ToPerl6::Transformation; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
15
|
use 5.006001; |
|
1
|
|
|
|
|
4
|
|
4
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
18
|
|
5
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
4
|
use English qw< -no_match_vars >; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
8
|
|
8
|
1
|
|
|
1
|
|
396
|
use Readonly; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
40
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
5
|
use File::Basename qw< basename >; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
11
|
1
|
|
|
1
|
|
5
|
use IO::String qw< >; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
17
|
|
12
|
1
|
|
|
1
|
|
4
|
use Pod::PlainText qw< >; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
17
|
|
13
|
1
|
|
|
1
|
|
5
|
use Scalar::Util qw< blessed >; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
14
|
1
|
|
|
1
|
|
5
|
use String::Format qw< stringf >; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
39
|
|
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
5
|
use overload ( q{""} => 'to_string', cmp => '_compare' ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
10
|
|
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
76
|
use Perl::ToPerl6::Utils qw< :characters :internal_lookup >; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
45
|
|
19
|
1
|
|
|
|
|
46
|
use Perl::ToPerl6::Utils::POD qw< |
20
|
|
|
|
|
|
|
get_pod_section_for_module |
21
|
|
|
|
|
|
|
trim_pod_section |
22
|
1
|
|
|
1
|
|
222
|
>; |
|
1
|
|
|
|
|
2
|
|
23
|
1
|
|
|
1
|
|
5
|
use Perl::ToPerl6::Exception::Fatal::Internal qw< throw_internal >; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1594
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
Readonly::Scalar my $LOCATION_LINE_NUMBER => 0; |
26
|
|
|
|
|
|
|
Readonly::Scalar my $LOCATION_COLUMN_NUMBER => 1; |
27
|
|
|
|
|
|
|
Readonly::Scalar my $LOCATION_VISUAL_COLUMN_NUMBER => 2; |
28
|
|
|
|
|
|
|
Readonly::Scalar my $LOCATION_LOGICAL_LINE_NUMBER => 3; |
29
|
|
|
|
|
|
|
Readonly::Scalar my $LOCATION_LOGICAL_FILENAME => 4; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# Class variables... |
33
|
|
|
|
|
|
|
my $format = "%m at line %l, column %c. %e.\n"; # Default stringy format |
34
|
|
|
|
|
|
|
my %diagnostics = (); # Cache of diagnostic messages |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Readonly::Scalar my $CONSTRUCTOR_ARG_COUNT => 5; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub new { |
41
|
1
|
|
|
1
|
1
|
8283
|
my ( $class, $desc, $expl, $elem, $sev ) = @_; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Check arguments to help out developers who might |
44
|
|
|
|
|
|
|
# be creating new Perl::ToPerl6::Transformer modules. |
45
|
|
|
|
|
|
|
|
46
|
1
|
50
|
|
|
|
6
|
if ( @_ != $CONSTRUCTOR_ARG_COUNT ) { |
47
|
0
|
|
|
|
|
0
|
throw_internal 'Wrong number of args to Transformation->new()'; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
1
|
50
|
|
|
|
3
|
if ( eval { $elem->isa( 'Perl::ToPerl6::Document' ) } ) { |
|
1
|
|
|
|
|
11
|
|
51
|
|
|
|
|
|
|
# break the facade, return the real PPI::Document |
52
|
0
|
|
|
|
|
0
|
$elem = $elem->ppi_document(); |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
1
|
50
|
|
|
|
4
|
if ( not eval { $elem->isa( 'PPI::Element' ) } ) { |
|
1
|
|
|
|
|
6
|
|
56
|
0
|
|
|
|
|
0
|
throw_internal '3rd arg to Transformation->new() must be a PPI::Element'; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# Strip punctuation. These are controlled by the user via the |
60
|
|
|
|
|
|
|
# formats. He/She can use whatever makes sense to them. |
61
|
1
|
|
|
|
|
6
|
($desc, $expl) = _chomp_periods($desc, $expl); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# Create object |
64
|
1
|
|
|
|
|
4
|
my $self = bless {}, $class; |
65
|
1
|
|
|
|
|
40
|
$self->{_description} = $desc; |
66
|
1
|
|
|
|
|
3
|
$self->{_explanation} = $expl; |
67
|
1
|
|
|
|
|
3
|
$self->{_necessity} = $sev; |
68
|
1
|
|
|
|
|
4
|
$self->{_transformer} = caller; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# PPI eviscerates the Elements in a Document when the Document gets |
71
|
|
|
|
|
|
|
# DESTROY()ed, and thus they aren't useful after it is gone. So we have |
72
|
|
|
|
|
|
|
# to preemptively grab everything we could possibly want. |
73
|
1
|
|
|
|
|
7
|
$self->{_element_class} = blessed $elem; |
74
|
|
|
|
|
|
|
|
75
|
1
|
|
|
|
|
15
|
my $top = $elem->top(); |
76
|
1
|
50
|
|
|
|
18
|
$self->{_filename} = $top->can('filename') ? $top->filename() : undef; |
77
|
1
|
|
|
|
|
4
|
$self->{_source} = _line_containing_transformation( $elem ); |
78
|
|
|
|
|
|
|
$self->{_location} = |
79
|
1
|
|
50
|
|
|
4
|
$elem->location() || [ 0, 0, 0, 0, $self->filename() ]; |
80
|
|
|
|
|
|
|
|
81
|
1
|
|
|
|
|
18
|
return $self; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
85
|
|
|
|
|
|
|
|
86
|
0
|
|
|
0
|
1
|
0
|
sub set_format { return $format = verbosity_to_format( $_[0] ); } |
87
|
0
|
|
|
0
|
1
|
0
|
sub get_format { return $format; } |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub sort_by_location { |
92
|
|
|
|
|
|
|
|
93
|
0
|
0
|
|
0
|
1
|
0
|
ref $_[0] || shift; # Can call as object or class method |
94
|
0
|
0
|
|
|
|
0
|
return scalar @_ if ! wantarray; # In case we are called in scalar context |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
## TODO: What if $a and $b are not Transformation objects? |
97
|
|
|
|
|
|
|
return |
98
|
0
|
|
|
|
|
0
|
map {$_->[0]} |
99
|
0
|
0
|
|
|
|
0
|
sort { ($a->[1] <=> $b->[1]) || ($a->[2] <=> $b->[2]) } |
100
|
0
|
|
0
|
|
|
0
|
map {[$_, $_->location->[0] || 0, $_->location->[1] || 0]} |
|
0
|
|
0
|
|
|
0
|
|
101
|
|
|
|
|
|
|
@_; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub sort_by_necessity { |
107
|
|
|
|
|
|
|
|
108
|
0
|
0
|
|
0
|
1
|
0
|
ref $_[0] || shift; # Can call as object or class method |
109
|
0
|
0
|
|
|
|
0
|
return scalar @_ if ! wantarray; # In case we are called in scalar context |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
## TODO: What if $a and $b are not Transformation objects? |
112
|
|
|
|
|
|
|
return |
113
|
0
|
|
|
|
|
0
|
map {$_->[0]} |
114
|
0
|
|
|
|
|
0
|
sort { $a->[1] <=> $b->[1] } |
115
|
0
|
|
0
|
|
|
0
|
map {[$_, $_->necessity() || 0]} |
|
0
|
|
|
|
|
0
|
|
116
|
|
|
|
|
|
|
@_; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub location { |
122
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
0
|
return $self->{_location}; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub line_number { |
130
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
0
|
return $self->location()->[$LOCATION_LINE_NUMBER]; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub logical_line_number { |
138
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
139
|
|
|
|
|
|
|
|
140
|
0
|
|
|
|
|
0
|
return $self->location()->[$LOCATION_LOGICAL_LINE_NUMBER]; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub column_number { |
146
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
147
|
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
0
|
return $self->location()->[$LOCATION_COLUMN_NUMBER]; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub visual_column_number { |
154
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
155
|
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
0
|
return $self->location()->[$LOCATION_VISUAL_COLUMN_NUMBER]; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub diagnostics { |
162
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
163
|
0
|
|
|
|
|
0
|
my $transformer = $self->transformer(); |
164
|
|
|
|
|
|
|
|
165
|
0
|
0
|
|
|
|
0
|
if ( not $diagnostics{$transformer} ) { |
166
|
0
|
|
|
|
|
0
|
eval { |
167
|
0
|
|
0
|
|
|
0
|
my $module_name = ref $transformer || $transformer; |
168
|
0
|
|
|
|
|
0
|
$diagnostics{$transformer} = |
169
|
|
|
|
|
|
|
trim_pod_section( |
170
|
|
|
|
|
|
|
get_pod_section_for_module( $module_name, 'DESCRIPTION' ) |
171
|
|
|
|
|
|
|
); |
172
|
|
|
|
|
|
|
}; |
173
|
0
|
|
0
|
|
|
0
|
$diagnostics{$transformer} ||= " No diagnostics available\n"; |
174
|
|
|
|
|
|
|
} |
175
|
0
|
|
|
|
|
0
|
return $diagnostics{$transformer}; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub description { |
181
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
182
|
0
|
|
|
|
|
0
|
return $self->{_description}; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub explanation { |
188
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
189
|
0
|
|
|
|
|
0
|
my $expl = $self->{_explanation}; |
190
|
0
|
0
|
|
|
|
0
|
if ( !$expl ) { |
191
|
0
|
|
|
|
|
0
|
$expl = '(no explanation)'; |
192
|
|
|
|
|
|
|
} |
193
|
0
|
0
|
|
|
|
0
|
if ( ref $expl eq 'ARRAY' ) { |
194
|
0
|
0
|
|
|
|
0
|
my $page = @{$expl} > 1 ? 'pages' : 'page'; |
|
0
|
|
|
|
|
0
|
|
195
|
0
|
|
|
|
|
0
|
$page .= $SPACE . join $COMMA, @{$expl}; |
|
0
|
|
|
|
|
0
|
|
196
|
0
|
|
|
|
|
0
|
$expl = "See $page of PBP"; |
197
|
|
|
|
|
|
|
} |
198
|
0
|
|
|
|
|
0
|
return $expl; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub necessity { |
204
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
205
|
0
|
|
|
|
|
0
|
return $self->{_necessity}; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub transformer { |
211
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
212
|
0
|
|
|
|
|
0
|
return $self->{_transformer}; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub filename { |
218
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
219
|
0
|
|
|
|
|
0
|
return $self->{_filename}; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub logical_filename { |
225
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
226
|
|
|
|
|
|
|
|
227
|
0
|
|
|
|
|
0
|
return $self->location()->[$LOCATION_LOGICAL_FILENAME]; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub source { |
233
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
234
|
0
|
|
|
|
|
0
|
return $self->{_source}; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub element_class { |
240
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
241
|
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
0
|
return $self->{_element_class}; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub to_string { |
248
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
249
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
0
|
my $long_transformer = $self->transformer(); |
251
|
0
|
|
|
|
|
0
|
(my $short_transformer = $long_transformer) =~ s/ \A Perl::ToPerl6::Transformer:: //xms; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# Wrap the more expensive ones in sub{} to postpone evaluation |
254
|
|
|
|
|
|
|
my %fspec = ( |
255
|
0
|
|
|
0
|
|
0
|
'f' => sub { $self->logical_filename() }, |
256
|
0
|
|
|
0
|
|
0
|
'F' => sub { basename( $self->logical_filename() ) }, |
257
|
0
|
|
|
0
|
|
0
|
'g' => sub { $self->filename() }, |
258
|
0
|
|
|
0
|
|
0
|
'G' => sub { basename( $self->filename() ) }, |
259
|
0
|
|
|
0
|
|
0
|
'l' => sub { $self->logical_line_number() }, |
260
|
0
|
|
|
0
|
|
0
|
'L' => sub { $self->line_number() }, |
261
|
0
|
|
|
0
|
|
0
|
'c' => sub { $self->visual_column_number() }, |
262
|
0
|
|
|
0
|
|
0
|
'C' => sub { $self->element_class() }, |
263
|
|
|
|
|
|
|
'm' => $self->description(), |
264
|
|
|
|
|
|
|
'e' => $self->explanation(), |
265
|
|
|
|
|
|
|
's' => $self->necessity(), |
266
|
0
|
|
|
0
|
|
0
|
'd' => sub { $self->diagnostics() }, |
267
|
0
|
|
|
0
|
|
0
|
'r' => sub { $self->source() }, |
268
|
0
|
|
|
|
|
0
|
'P' => $long_transformer, |
269
|
|
|
|
|
|
|
'p' => $short_transformer, |
270
|
|
|
|
|
|
|
); |
271
|
0
|
|
|
|
|
0
|
return stringf($format, %fspec); |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
275
|
|
|
|
|
|
|
# Apparently, some perls do not implicitly stringify overloading |
276
|
|
|
|
|
|
|
# objects before doing a comparison. This causes a couple of our |
277
|
|
|
|
|
|
|
# sorting tests to fail. To work around this, we overload C<cmp> to |
278
|
|
|
|
|
|
|
# do it explicitly. |
279
|
|
|
|
|
|
|
# |
280
|
|
|
|
|
|
|
# 20060503 - More information: This problem has been traced to |
281
|
|
|
|
|
|
|
# Test::Simple versions <= 0.60, not perl itself. Upgrading to |
282
|
|
|
|
|
|
|
# Test::Simple v0.62 will fix the problem. But rather than forcing |
283
|
|
|
|
|
|
|
# everyone to upgrade, I have decided to leave this workaround in |
284
|
|
|
|
|
|
|
# place. |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
0
|
|
0
|
sub _compare { return "$_[0]" cmp "$_[1]" } |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
sub _line_containing_transformation { |
291
|
1
|
|
|
1
|
|
3
|
my ( $elem ) = @_; |
292
|
|
|
|
|
|
|
|
293
|
1
|
|
33
|
|
|
8
|
my $stmnt = $elem->statement() || $elem; |
294
|
1
|
|
33
|
|
|
22
|
my $code_string = $stmnt->content() || $EMPTY; |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# Split into individual lines |
297
|
1
|
|
|
|
|
34
|
my @lines = split qr{ \n\s* }xms, $code_string; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
# Take the line containing the element that is in transformation |
300
|
1
|
|
50
|
|
|
9
|
my $inx = ( $elem->line_number() || 0 ) - |
|
|
|
50
|
|
|
|
|
301
|
|
|
|
|
|
|
( $stmnt->line_number() || 0 ); |
302
|
1
|
50
|
|
|
|
295
|
$inx > @lines and return $EMPTY; |
303
|
1
|
|
|
|
|
4
|
return $lines[$inx]; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub _chomp_periods { |
309
|
1
|
|
|
1
|
|
3
|
my @args = @_; |
310
|
|
|
|
|
|
|
|
311
|
1
|
|
|
|
|
4
|
for (@args) { |
312
|
2
|
50
|
33
|
|
|
9
|
next if not defined or ref; |
313
|
0
|
|
|
|
|
0
|
s{ [.]+ \z }{}xms |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
1
|
|
|
|
|
3
|
return @args; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
1; |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
__END__ |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=head1 NAME |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
Perl::ToPerl6::Transformation - A transformation of a Transformer found in some source code. |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=head1 SYNOPSIS |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
use PPI; |
335
|
|
|
|
|
|
|
use Perl::ToPerl6::Transformation; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
my $elem = $doc->child(0); # $doc is a PPI::Document object |
338
|
|
|
|
|
|
|
my $desc = 'Offending code'; # Describe the transformation |
339
|
|
|
|
|
|
|
my $expl = [1,45,67]; # Page numbers from PBP |
340
|
|
|
|
|
|
|
my $sev = 5; # Necessity level of this transformation |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
my $vio = Perl::ToPerl6::Transformation->new($desc, $expl, $node, $sev); |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=head1 DESCRIPTION |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
Perl::ToPerl6::Transformation is the generic representation of an individual |
348
|
|
|
|
|
|
|
Transformer transformation. Its primary purpose is to provide an abstraction |
349
|
|
|
|
|
|
|
layer so that clients of L<Perl::ToPerl6|Perl::ToPerl6> don't have to |
350
|
|
|
|
|
|
|
know anything about L<PPI|PPI>. The C<transformations> method of all |
351
|
|
|
|
|
|
|
L<Perl::ToPerl6::Transformer|Perl::ToPerl6::Transformer> subclasses must return a |
352
|
|
|
|
|
|
|
list of these Perl::ToPerl6::Transformation objects. |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=head1 INTERFACE SUPPORT |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
This is considered to be a public class. Any changes to its interface |
358
|
|
|
|
|
|
|
will go through a deprecation cycle. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=over |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
=item C<new( $description, $explanation, $element, $necessity )> |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
Returns a reference to a new C<Perl::ToPerl6::Transformation> object. The |
368
|
|
|
|
|
|
|
arguments are a description of the transformation (as string), an |
369
|
|
|
|
|
|
|
explanation for the transformer (as string) or a series of page numbers in |
370
|
|
|
|
|
|
|
PBP (as an ARRAY ref), a reference to the L<PPI|PPI> element that |
371
|
|
|
|
|
|
|
caused the transformation, and the necessity of the transformation (as an |
372
|
|
|
|
|
|
|
integer). |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=back |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=head1 METHODS |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=over |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=item C<description()> |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
Returns a brief description of the specific transformation. In other |
385
|
|
|
|
|
|
|
words, this value may change on a per transformation basis. |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=item C<explanation()> |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Returns an explanation of the transformer as a string or as reference to an |
391
|
|
|
|
|
|
|
array of page numbers in PBP. This value will generally not change |
392
|
|
|
|
|
|
|
based upon the specific code violating the transformer. |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=item C<location()> |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Don't use this method. Use the C<line_number()>, |
398
|
|
|
|
|
|
|
C<logical_line_number()>, C<column_number()>, |
399
|
|
|
|
|
|
|
C<visual_column_number()>, and C<logical_filename()> methods instead. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
Returns a five-element array reference containing the line and real & |
402
|
|
|
|
|
|
|
virtual column and logical numbers and logical file name where this |
403
|
|
|
|
|
|
|
Transformation occurred, as in L<PPI::Element|PPI::Element>. |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=item C<line_number()> |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
Returns the physical line number that the transformation was found on. |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
=item C<logical_line_number()> |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
Returns the logical line number that the transformation was found on. This |
414
|
|
|
|
|
|
|
can differ from the physical line number when there were C<#line> |
415
|
|
|
|
|
|
|
directives in the code. |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=item C<column_number()> |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Returns the physical column that the transformation was found at. This |
421
|
|
|
|
|
|
|
means that hard tab characters count as a single character. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=item C<visual_column_number()> |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
Returns the column that the transformation was found at, as it would appear |
427
|
|
|
|
|
|
|
if hard tab characters were expanded, based upon the value of |
428
|
|
|
|
|
|
|
L<PPI::Document/"tab_width [ $width ]">. |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=item C<filename()> |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
Returns the path to the file where this Transformation occurred. In some |
434
|
|
|
|
|
|
|
cases, the path may be undefined because the source code was not read |
435
|
|
|
|
|
|
|
directly from a file. |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=item C<logical_filename()> |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Returns the logical path to the file where the Transformation occurred. |
441
|
|
|
|
|
|
|
This can differ from C<filename()> when there was a C<#line> directive |
442
|
|
|
|
|
|
|
in the code. |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=item C<necessity()> |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
Returns the necessity of this Transformation as an integer ranging from 1 to |
448
|
|
|
|
|
|
|
5, where 5 is the "most" severe. |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=item C<sort_by_necessity( @transformation_objects )> |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
If you need to sort Transformations by necessity, use this handy routine: |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
@sorted = Perl::ToPerl6::Transformation::sort_by_necessity(@transformations); |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=item C<sort_by_location( @transformation_objects )> |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
If you need to sort Transformations by location, use this handy routine: |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
@sorted = Perl::ToPerl6::Transformation::sort_by_location(@transformations); |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
=item C<diagnostics()> |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
Returns a formatted string containing a full discussion of the |
468
|
|
|
|
|
|
|
motivation for and details of the Transformer module that created this |
469
|
|
|
|
|
|
|
Transformation. This information is automatically extracted from the |
470
|
|
|
|
|
|
|
C<DESCRIPTION> section of the Transformer module's POD. |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=item C<transformer()> |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
Returns the name of the L<Perl::ToPerl6::Transformer|Perl::ToPerl6::Transformer> |
476
|
|
|
|
|
|
|
that created this Transformation. |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=item C<source()> |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
Returns the string of source code that caused this exception. If the |
482
|
|
|
|
|
|
|
code spans multiple lines (e.g. multi-line statements, subroutines or |
483
|
|
|
|
|
|
|
other blocks), then only the line containing the transformation will be |
484
|
|
|
|
|
|
|
returned. |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=item C<element_class()> |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
Returns the L<PPI::Element|PPI::Element> subclass of the code that caused this |
490
|
|
|
|
|
|
|
exception. |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=item C<set_format( $format )> |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
Class method. Sets the format for all Transformation objects when they are |
496
|
|
|
|
|
|
|
evaluated in string context. The default is C<'%d at line %l, column |
497
|
|
|
|
|
|
|
%c. %e'>. See L<"OVERLOADS"> for formatting options. |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=item C<get_format()> |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
Class method. Returns the current format for all Transformation objects |
503
|
|
|
|
|
|
|
when they are evaluated in string context. |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=item C<to_string()> |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
Returns a string representation of this transformation. The content of the |
509
|
|
|
|
|
|
|
string depends on the current value of the C<$format> package |
510
|
|
|
|
|
|
|
variable. See L<"OVERLOADS"> for the details. |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=back |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
=head1 OVERLOADS |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
Perl::ToPerl6::Transformation overloads the C<""> operator to produce neat |
519
|
|
|
|
|
|
|
little messages when evaluated in string context. |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
Formats are a combination of literal and escape characters similar to |
522
|
|
|
|
|
|
|
the way C<sprintf> works. If you want to know the specific formatting |
523
|
|
|
|
|
|
|
capabilities, look at L<String::Format|String::Format>. Valid escape |
524
|
|
|
|
|
|
|
characters are: |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
Escape Meaning |
527
|
|
|
|
|
|
|
------- ---------------------------------------------------------------- |
528
|
|
|
|
|
|
|
%c Column number where the transformation occurred |
529
|
|
|
|
|
|
|
%d Full diagnostic discussion of the transformation (DESCRIPTION in POD) |
530
|
|
|
|
|
|
|
%e Explanation of transformation or page numbers in PBP |
531
|
|
|
|
|
|
|
%F Just the name of the logical file where the transformation occurred. |
532
|
|
|
|
|
|
|
%f Path to the logical file where the transformation occurred. |
533
|
|
|
|
|
|
|
%G Just the name of the physical file where the transformation occurred. |
534
|
|
|
|
|
|
|
%g Path to the physical file where the transformation occurred. |
535
|
|
|
|
|
|
|
%l Logical line number where the transformation occurred |
536
|
|
|
|
|
|
|
%L Physical line number where the transformation occurred |
537
|
|
|
|
|
|
|
%m Brief description of the transformation |
538
|
|
|
|
|
|
|
%P Full name of the Transformer module that created the transformation |
539
|
|
|
|
|
|
|
%p Name of the Transformer without the Perl::ToPerl6::Transformer:: prefix |
540
|
|
|
|
|
|
|
%r The string of source code that caused the transformation |
541
|
|
|
|
|
|
|
%C The class of the PPI::Element that caused the transformation |
542
|
|
|
|
|
|
|
%s The necessity level of the transformation |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Explanation of the C<%F>, C<%f>, C<%G>, C<%G>, C<%l>, and C<%L> formats: |
545
|
|
|
|
|
|
|
Using C<#line> directives, you can affect what perl thinks the current line |
546
|
|
|
|
|
|
|
number and file name are; see L<perlsyn/Plain Old Comments (Not!)> for |
547
|
|
|
|
|
|
|
the details. Under normal circumstances, the values of C<%F>, C<%f>, and |
548
|
|
|
|
|
|
|
C<%l> will match the values of C<%G>, C<%g>, and C<%L>, respectively. In the |
549
|
|
|
|
|
|
|
presence of a C<#line> directive, the values of C<%F>, C<%f>, and C<%l> will |
550
|
|
|
|
|
|
|
change to take that directive into account. The values of C<%G>, C<%g>, and |
551
|
|
|
|
|
|
|
C<%L> are unaffected by those directives. |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
Here are some examples: |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
Perl::ToPerl6::Transformation::set_format("%m at line %l, column %c.\n"); |
556
|
|
|
|
|
|
|
# looks like "Mixed case variable name at line 6, column 23." |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
Perl::ToPerl6::Transformation::set_format("%m near '%r'\n"); |
559
|
|
|
|
|
|
|
# looks like "Mixed case variable name near 'my $theGreatAnswer = 42;'" |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
Perl::ToPerl6::Transformation::set_format("%l:%c:%p\n"); |
562
|
|
|
|
|
|
|
# looks like "6:23:NamingConventions::Capitalization" |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
Perl::ToPerl6::Transformation::set_format("%m at line %l. %e. \n%d\n"); |
565
|
|
|
|
|
|
|
# looks like "Mixed case variable name at line 6. See page 44 of PBP. |
566
|
|
|
|
|
|
|
Conway's recommended naming convention is to use lower-case words |
567
|
|
|
|
|
|
|
separated by underscores. Well-recognized acronyms can be in ALL |
568
|
|
|
|
|
|
|
CAPS, but must be separated by underscores from other parts of the |
569
|
|
|
|
|
|
|
name." |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=head1 AUTHOR |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com> |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
=head1 COPYRIGHT |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved. |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
582
|
|
|
|
|
|
|
it under the same terms as Perl itself. The full text of this license |
583
|
|
|
|
|
|
|
can be found in the LICENSE file included with this module. |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=cut |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
# Local Variables: |
588
|
|
|
|
|
|
|
# mode: cperl |
589
|
|
|
|
|
|
|
# cperl-indent-level: 4 |
590
|
|
|
|
|
|
|
# fill-column: 78 |
591
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
592
|
|
|
|
|
|
|
# c-indentation-style: bsd |
593
|
|
|
|
|
|
|
# End: |
594
|
|
|
|
|
|
|
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround : |