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 use English qw( -no_match_vars );
  12 our $VERSION = '20230309';
  13
  14 use constant DEVEL_MODE => 0;
  15
  16 sub AUTOLOAD {
  17
  18     # Catch any undefined sub calls so that we are sure to get
  19     # some diagnostic information.  This sub should never be called
  20     # except for a programming error.
  21     our $AUTOLOAD;
  22     return if ( $AUTOLOAD =~ /\bDESTROY$/ );
  23     my ( $pkg, $fname, $lno ) = caller();
  24     my $my_package = __PACKAGE__;
  25     print STDERR <<EOM;
  26 ======================================================================
  27 Error detected in package '$my_package', version $VERSION
  28 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
  29 Called from package: '$pkg'
  30 Called from File '$fname'  at line '$lno'
  31 This error is probably due to a recent programming change
  32 ======================================================================
  33 EOM
  34     exit 1;
  35 }
  36
  37 sub DESTROY {
  38
  39     # required to avoid call to AUTOLOAD in some versions of perl
  40 }
  41
  42 sub new {
  43
  44     my ( $class, @args ) = @_;
  45
  46     my %defaults = (
  47         input_file => undef,
  48         rOpts      => undef,
  49     );
  50
  51     my %args = ( %defaults, @args );
  52
  53     my $input_file = $args{input_file};
  54     my $rOpts      = $args{rOpts};
  55
  56     ( my $fh, $input_file ) = Perl::Tidy::streamhandle( $input_file, 'r' );
  57     return unless $fh;
  58
  59     return bless {
  60         _fh            => $fh,
  61         _filename      => $input_file,
  62         _rinput_buffer => [],
  63         _started       => 0,
  64     }, $class;
  65 }
  66
  67 sub close_input_file {
  68     my $self = shift;
  69
  70     # Only close physical files, not STDIN and other objects
  71     my $filename = $self->{_filename};
  72     if ( $filename ne '-' && !ref $filename ) {
  73         my $ok = eval { $self->{_fh}->close(); 1 };
  74         if ( !$ok && DEVEL_MODE ) {
  75             Fault("Could not close file handle(): $EVAL_ERROR\n");
  76         }
  77     }
  78     return;
  79 }
  80
  81 sub get_line {
  82     my $self          = shift;
  83     my $line          = undef;
  84     my $fh            = $self->{_fh};
  85     my $rinput_buffer = $self->{_rinput_buffer};
  86
  87     if ( scalar( @{$rinput_buffer} ) ) {
  88         $line = shift @{$rinput_buffer};
  89     }
  90     else {
  91         $line = $fh->getline();
  92
  93         # patch to read raw mac files under unix, dos
  94         # see if the first line has embedded \r's
  95         if ( $line && !$self->{_started} ) {
  96             if ( $line =~ /[\015][^\015\012]/ ) {
  97
  98                 # found one -- break the line up and store in a buffer
  99                 @{$rinput_buffer} = map { $_ . "\n" } split /\015/, $line;
 100                 my $count = @{$rinput_buffer};
 101                 $line = shift @{$rinput_buffer};
 102             }
 103             $self->{_started}++;
 104         }
 105     }
 106     return $line;
 107 }
 108 1;