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 = '20221112';
  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 $input_line_ending;
  57     if ( $rOpts->{'preserve-line-endings'} ) {
  58         $input_line_ending = Perl::Tidy::find_input_line_ending($input_file);
  59     }
  60
  61     ( my $fh, $input_file ) = Perl::Tidy::streamhandle( $input_file, 'r' );
  62     return unless $fh;
  63
  64     return bless {
  65         _fh                => $fh,
  66         _filename          => $input_file,
  67         _input_line_ending => $input_line_ending,
  68         _rinput_buffer     => [],
  69         _started           => 0,
  70     }, $class;
  71 }
  72
  73 sub close_input_file {
  74     my $self = shift;
  75
  76     # Only close physical files, not STDIN and other objects
  77     my $filename = $self->{_filename};
  78     if ( $filename ne '-' && !ref $filename ) {
  79         my $ok = eval { $self->{_fh}->close(); 1 };
  80         if ( !$ok && DEVEL_MODE ) {
  81             Fault("Could not close file handle(): $EVAL_ERROR\n");
  82         }
  83     }
  84     return;
  85 }
  86
  87 sub get_line {
  88     my $self          = shift;
  89     my $line          = undef;
  90     my $fh            = $self->{_fh};
  91     my $rinput_buffer = $self->{_rinput_buffer};
  92
  93     if ( scalar( @{$rinput_buffer} ) ) {
  94         $line = shift @{$rinput_buffer};
  95     }
  96     else {
  97         $line = $fh->getline();
  98
  99         # patch to read raw mac files under unix, dos
 100         # see if the first line has embedded \r's
 101         if ( $line && !$self->{_started} ) {
 102             if ( $line =~ /[\015][^\015\012]/ ) {
 103
 104                 # found one -- break the line up and store in a buffer
 105                 @{$rinput_buffer} = map { $_ . "\n" } split /\015/, $line;
 106                 my $count = @{$rinput_buffer};
 107                 $line = shift @{$rinput_buffer};
 108             }
 109             $self->{_started}++;
 110         }
 111     }
 112     return $line;
 113 }
 114 1;