lib/Perl/Tidy/LineSource.pm

   1 #####################################################################
   2 #
   3 # the Perl::Tidy::LineSource class supplies an object with a 'get_line()' method
   4 # which returns the next line to be parsed
   5 #
   6 #####################################################################
   7
   8 package Perl::Tidy::LineSource;
   9 use strict;
  10 use warnings;
  11 our $VERSION = '20210717';
  12
  13 sub AUTOLOAD {
  14
  15     # Catch any undefined sub calls so that we are sure to get
  16     # some diagnostic information.  This sub should never be called
  17     # except for a programming error.
  18     our $AUTOLOAD;
  19     return if ( $AUTOLOAD =~ /\bDESTROY$/ );
  20     my ( $pkg, $fname, $lno ) = caller();
  21     my $my_package = __PACKAGE__;
  22     print STDERR <<EOM;
  23 ======================================================================
  24 Error detected in package '$my_package', version $VERSION
  25 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
  26 Called from package: '$pkg'
  27 Called from File '$fname'  at line '$lno'
  28 This error is probably due to a recent programming change
  29 ======================================================================
  30 EOM
  31     exit 1;
  32 }
  33
  34 sub DESTROY {
  35
  36     # required to avoid call to AUTOLOAD in some versions of perl
  37 }
  38
  39 sub new {
  40
  41     my ( $class, @args ) = @_;
  42
  43     my %defaults = (
  44         input_file               => undef,
  45         rOpts                    => undef,
  46         rpending_logfile_message => undef,
  47     );
  48
  49     my %args = ( %defaults, @args );
  50
  51     my $input_file               = $args{input_file};
  52     my $rOpts                    = $args{rOpts};
  53     my $rpending_logfile_message = $args{rpending_logfile_message};
  54
  55     my $input_line_ending;
  56     if ( $rOpts->{'preserve-line-endings'} ) {
  57         $input_line_ending = Perl::Tidy::find_input_line_ending($input_file);
  58     }
  59
  60     ( my $fh, $input_file ) = Perl::Tidy::streamhandle( $input_file, 'r' );
  61     return unless $fh;
  62
  63     # in order to check output syntax when standard output is used,
  64     # or when it is an object, we have to make a copy of the file
  65     if ( ( $input_file eq '-' || ref $input_file ) && $rOpts->{'check-syntax'} )
  66     {
  67
  68         # Turning off syntax check when input output is used.
  69         # The reason is that temporary files cause problems on
  70         # on many systems.
  71         $rOpts->{'check-syntax'} = 0;
  72
  73         ${$rpending_logfile_message} .= <<EOM;
  74 Note: --syntax check will be skipped because standard input is used
  75 EOM
  76
  77     }
  78
  79     return bless {
  80         _fh                => $fh,
  81         _filename          => $input_file,
  82         _input_line_ending => $input_line_ending,
  83         _rinput_buffer     => [],
  84         _started           => 0,
  85     }, $class;
  86 }
  87
  88 sub close_input_file {
  89     my $self = shift;
  90
  91     # Only close physical files, not STDIN and other objects
  92     my $filename = $self->{_filename};
  93     if ( $filename ne '-' && !ref $filename ) {
  94         eval { $self->{_fh}->close() };
  95     }
  96     return;
  97 }
  98
  99 sub get_line {
 100     my $self          = shift;
 101     my $line          = undef;
 102     my $fh            = $self->{_fh};
 103     my $rinput_buffer = $self->{_rinput_buffer};
 104
 105     if ( scalar( @{$rinput_buffer} ) ) {
 106         $line = shift @{$rinput_buffer};
 107     }
 108     else {
 109         $line = $fh->getline();
 110
 111         # patch to read raw mac files under unix, dos
 112         # see if the first line has embedded \r's
 113         if ( $line && !$self->{_started} ) {
 114             if ( $line =~ /[\015][^\015\012]/ ) {
 115
 116                 # found one -- break the line up and store in a buffer
 117                 @{$rinput_buffer} = map { $_ . "\n" } split /\015/, $line;
 118                 my $count = @{$rinput_buffer};
 119                 $line = shift @{$rinput_buffer};
 120             }
 121             $self->{_started}++;
 122         }
 123     }
 124     return $line;
 125 }
 126 1;
 127