1 #####################################################################
3 # the Perl::Tidy::FileWriter class writes the output file
5 #####################################################################
7 package Perl::Tidy::FileWriter;
10 our $VERSION = '20200110';
12 # Maximum number of little messages; probably need not be changed.
13 my $MAX_NAG_MESSAGES = 6;
15 sub write_logfile_entry {
16 my ( $self, $msg ) = @_;
17 my $logger_object = $self->{_logger_object};
19 $logger_object->write_logfile_entry($msg);
25 my ( $class, $line_sink_object, $rOpts, $logger_object ) = @_;
28 _line_sink_object => $line_sink_object,
29 _logger_object => $logger_object,
31 _output_line_number => 1,
32 _consecutive_blank_lines => 0,
33 _consecutive_nonblank_lines => 0,
34 _first_line_length_error => 0,
35 _max_line_length_error => 0,
36 _last_line_length_error => 0,
37 _first_line_length_error_at => 0,
38 _max_line_length_error_at => 0,
39 _last_line_length_error_at => 0,
40 _line_length_error_count => 0,
41 _max_output_line_length => 0,
42 _max_output_line_length_at => 0,
48 $self->{_line_sink_object}->tee_on();
54 $self->{_line_sink_object}->tee_off();
58 sub get_output_line_number {
60 return $self->{_output_line_number};
63 sub decrement_output_line_number {
65 $self->{_output_line_number}--;
69 sub get_consecutive_nonblank_lines {
71 return $self->{_consecutive_nonblank_lines};
74 sub reset_consecutive_blank_lines {
76 $self->{_consecutive_blank_lines} = 0;
82 unless ( $self->{_consecutive_blank_lines} ) {
83 $self->write_blank_code_line();
88 sub require_blank_code_lines {
90 # write out the requested number of blanks regardless of the value of -mbl
91 # unless -mbl=0. This allows extra blank lines to be written for subs and
92 # packages even with the default -mbl=1
93 my ( $self, $count ) = @_;
94 my $need = $count - $self->{_consecutive_blank_lines};
95 my $rOpts = $self->{_rOpts};
96 my $forced = $rOpts->{'maximum-consecutive-blank-lines'} > 0;
97 foreach my $i ( 0 .. $need - 1 ) {
98 $self->write_blank_code_line($forced);
103 sub write_blank_code_line {
106 my $rOpts = $self->{_rOpts};
109 && $self->{_consecutive_blank_lines} >=
110 $rOpts->{'maximum-consecutive-blank-lines'} );
111 $self->{_consecutive_blank_lines}++;
112 $self->{_consecutive_nonblank_lines} = 0;
113 $self->write_line("\n");
117 sub write_code_line {
121 if ( $a =~ /^\s*$/ ) {
122 my $rOpts = $self->{_rOpts};
124 if ( $self->{_consecutive_blank_lines} >=
125 $rOpts->{'maximum-consecutive-blank-lines'} );
126 $self->{_consecutive_blank_lines}++;
127 $self->{_consecutive_nonblank_lines} = 0;
130 $self->{_consecutive_blank_lines} = 0;
131 $self->{_consecutive_nonblank_lines}++;
133 $self->write_line($a);
138 my ( $self, $a ) = @_;
140 # TODO: go through and see if the test is necessary here
141 if ( $a =~ /\n$/ ) { $self->{_output_line_number}++; }
143 $self->{_line_sink_object}->write_line($a);
145 # This calculation of excess line length ignores any internal tabs
146 my $rOpts = $self->{_rOpts};
147 my $exceed = length($a) - $rOpts->{'maximum-line-length'} - 1;
148 if ( $a =~ /^\t+/g ) {
149 $exceed += pos($a) * ( $rOpts->{'indent-columns'} - 1 );
152 # Note that we just incremented output line number to future value
153 # so we must subtract 1 for current line number
154 if ( length($a) > 1 + $self->{_max_output_line_length} ) {
155 $self->{_max_output_line_length} = length($a) - 1;
156 $self->{_max_output_line_length_at} = $self->{_output_line_number} - 1;
160 my $output_line_number = $self->{_output_line_number};
161 $self->{_last_line_length_error} = $exceed;
162 $self->{_last_line_length_error_at} = $output_line_number - 1;
163 if ( $self->{_line_length_error_count} == 0 ) {
164 $self->{_first_line_length_error} = $exceed;
165 $self->{_first_line_length_error_at} = $output_line_number - 1;
169 $self->{_last_line_length_error} > $self->{_max_line_length_error} )
171 $self->{_max_line_length_error} = $exceed;
172 $self->{_max_line_length_error_at} = $output_line_number - 1;
175 if ( $self->{_line_length_error_count} < $MAX_NAG_MESSAGES ) {
176 $self->write_logfile_entry(
177 "Line length exceeded by $exceed characters\n");
179 $self->{_line_length_error_count}++;
184 sub report_line_length_errors {
186 my $rOpts = $self->{_rOpts};
187 my $line_length_error_count = $self->{_line_length_error_count};
188 if ( $line_length_error_count == 0 ) {
189 $self->write_logfile_entry(
190 "No lines exceeded $rOpts->{'maximum-line-length'} characters\n");
191 my $max_output_line_length = $self->{_max_output_line_length};
192 my $max_output_line_length_at = $self->{_max_output_line_length_at};
193 $self->write_logfile_entry(
194 " Maximum output line length was $max_output_line_length at line $max_output_line_length_at\n"
200 my $word = ( $line_length_error_count > 1 ) ? "s" : "";
201 $self->write_logfile_entry(
202 "$line_length_error_count output line$word exceeded $rOpts->{'maximum-line-length'} characters:\n"
205 $word = ( $line_length_error_count > 1 ) ? "First" : "";
206 my $first_line_length_error = $self->{_first_line_length_error};
207 my $first_line_length_error_at = $self->{_first_line_length_error_at};
208 $self->write_logfile_entry(
209 " $word at line $first_line_length_error_at by $first_line_length_error characters\n"
212 if ( $line_length_error_count > 1 ) {
213 my $max_line_length_error = $self->{_max_line_length_error};
214 my $max_line_length_error_at = $self->{_max_line_length_error_at};
215 my $last_line_length_error = $self->{_last_line_length_error};
216 my $last_line_length_error_at = $self->{_last_line_length_error_at};
217 $self->write_logfile_entry(
218 " Maximum at line $max_line_length_error_at by $max_line_length_error characters\n"
220 $self->write_logfile_entry(
221 " Last at line $last_line_length_error_at by $last_line_length_error characters\n"