lib/Perl/Tidy/FileWriter.pm

   1 #####################################################################
   2 #
   3 # the Perl::Tidy::FileWriter class writes the output file
   4 #
   5 #####################################################################
   6
   7 package Perl::Tidy::FileWriter;
   8 use strict;
   9 use warnings;
  10 our $VERSION = '20181120';
  11
  12 # Maximum number of little messages; probably need not be changed.
  13 my $MAX_NAG_MESSAGES = 6;
  14
  15 sub write_logfile_entry {
  16     my ( $self, $msg ) = @_;
  17     my $logger_object = $self->{_logger_object};
  18     if ($logger_object) {
  19         $logger_object->write_logfile_entry($msg);
  20     }
  21     return;
  22 }
  23
  24 sub new {
  25     my ( $class, $line_sink_object, $rOpts, $logger_object ) = @_;
  26
  27     return bless {
  28         _line_sink_object           => $line_sink_object,
  29         _logger_object              => $logger_object,
  30         _rOpts                      => $rOpts,
  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,
  43     }, $class;
  44 }
  45
  46 sub tee_on {
  47     my $self = shift;
  48     $self->{_line_sink_object}->tee_on();
  49     return;
  50 }
  51
  52 sub tee_off {
  53     my $self = shift;
  54     $self->{_line_sink_object}->tee_off();
  55     return;
  56 }
  57
  58 sub get_output_line_number {
  59     my $self = shift;
  60     return $self->{_output_line_number};
  61 }
  62
  63 sub decrement_output_line_number {
  64     my $self = shift;
  65     $self->{_output_line_number}--;
  66     return;
  67 }
  68
  69 sub get_consecutive_nonblank_lines {
  70     my $self = shift;
  71     return $self->{_consecutive_nonblank_lines};
  72 }
  73
  74 sub reset_consecutive_blank_lines {
  75     my $self = shift;
  76     $self->{_consecutive_blank_lines} = 0;
  77     return;
  78 }
  79
  80 sub want_blank_line {
  81     my $self = shift;
  82     unless ( $self->{_consecutive_blank_lines} ) {
  83         $self->write_blank_code_line();
  84     }
  85     return;
  86 }
  87
  88 sub require_blank_code_lines {
  89
  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);
  99     }
 100     return;
 101 }
 102
 103 sub write_blank_code_line {
 104     my $self   = shift;
 105     my $forced = shift;
 106     my $rOpts  = $self->{_rOpts};
 107     return
 108       if (!$forced
 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");
 114     return;
 115 }
 116
 117 sub write_code_line {
 118     my $self = shift;
 119     my $a    = shift;
 120
 121     if ( $a =~ /^\s*$/ ) {
 122         my $rOpts = $self->{_rOpts};
 123         return
 124           if ( $self->{_consecutive_blank_lines} >=
 125             $rOpts->{'maximum-consecutive-blank-lines'} );
 126         $self->{_consecutive_blank_lines}++;
 127         $self->{_consecutive_nonblank_lines} = 0;
 128     }
 129     else {
 130         $self->{_consecutive_blank_lines} = 0;
 131         $self->{_consecutive_nonblank_lines}++;
 132     }
 133     $self->write_line($a);
 134     return;
 135 }
 136
 137 sub write_line {
 138     my ( $self, $a ) = @_;
 139
 140     # TODO: go through and see if the test is necessary here
 141     if ( $a =~ /\n$/ ) { $self->{_output_line_number}++; }
 142
 143     $self->{_line_sink_object}->write_line($a);
 144
 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 );
 150     }
 151
 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;
 157     }
 158
 159     if ( $exceed > 0 ) {
 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;
 166         }
 167
 168         if (
 169             $self->{_last_line_length_error} > $self->{_max_line_length_error} )
 170         {
 171             $self->{_max_line_length_error}    = $exceed;
 172             $self->{_max_line_length_error_at} = $output_line_number - 1;
 173         }
 174
 175         if ( $self->{_line_length_error_count} < $MAX_NAG_MESSAGES ) {
 176             $self->write_logfile_entry(
 177                 "Line length exceeded by $exceed characters\n");
 178         }
 179         $self->{_line_length_error_count}++;
 180     }
 181     return;
 182 }
 183
 184 sub report_line_length_errors {
 185     my $self                    = shift;
 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"
 195         );
 196
 197     }
 198     else {
 199
 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"
 203         );
 204
 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"
 210         );
 211
 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"
 219             );
 220             $self->write_logfile_entry(
 221 " Last at line $last_line_length_error_at by $last_line_length_error characters\n"
 222             );
 223         }
 224     }
 225     return;
 226 }
 227 1;
 228