"Fossies" - the Fresh Open Source Software Archive

Member "Perl-Tidy-20200110/lib/Perl/Tidy/FileWriter.pm" (7 Jan 2020, 7194 Bytes) of package /linux/misc/Perl-Tidy-20200110.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "FileWriter.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 20191203_vs_20200110.

    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 = '20200110';
   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