lib/Perl/Tidy/LineBuffer.pm

   1 #####################################################################
   2 #
   3 # The Perl::Tidy::LineBuffer class supplies a 'get_line()'
   4 # method for returning the next line to be parsed, as well as a
   5 # 'peek_ahead()' method
   6 #
   7 # The input parameter is an object with a 'get_line()' method
   8 # which returns the next line to be parsed
   9 #
  10 #####################################################################
  11
  12 package Perl::Tidy::LineBuffer;
  13 use strict;
  14 use warnings;
  15 our $VERSION = '20210717';
  16
  17 sub AUTOLOAD {
  18
  19     # Catch any undefined sub calls so that we are sure to get
  20     # some diagnostic information.  This sub should never be called
  21     # except for a programming error.
  22     our $AUTOLOAD;
  23     return if ( $AUTOLOAD =~ /\bDESTROY$/ );
  24     my ( $pkg, $fname, $lno ) = caller();
  25     my $my_package = __PACKAGE__;
  26     print STDERR <<EOM;
  27 ======================================================================
  28 Error detected in package '$my_package', version $VERSION
  29 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
  30 Called from package: '$pkg'
  31 Called from File '$fname'  at line '$lno'
  32 This error is probably due to a recent programming change
  33 ======================================================================
  34 EOM
  35     exit 1;
  36 }
  37
  38 sub DESTROY {
  39
  40     # required to avoid call to AUTOLOAD in some versions of perl
  41 }
  42
  43 sub new {
  44
  45     my ( $class, $line_source_object ) = @_;
  46
  47     return bless {
  48         _line_source_object => $line_source_object,
  49         _rlookahead_buffer  => [],
  50     }, $class;
  51 }
  52
  53 sub peek_ahead {
  54     my ( $self, $buffer_index ) = @_;
  55     my $line               = undef;
  56     my $line_source_object = $self->{_line_source_object};
  57     my $rlookahead_buffer  = $self->{_rlookahead_buffer};
  58     if ( $buffer_index < scalar( @{$rlookahead_buffer} ) ) {
  59         $line = $rlookahead_buffer->[$buffer_index];
  60     }
  61     else {
  62         $line = $line_source_object->get_line();
  63         push( @{$rlookahead_buffer}, $line );
  64     }
  65     return $line;
  66 }
  67
  68 sub get_line {
  69     my $self               = shift;
  70     my $line               = undef;
  71     my $line_source_object = $self->{_line_source_object};
  72     my $rlookahead_buffer  = $self->{_rlookahead_buffer};
  73
  74     if ( scalar( @{$rlookahead_buffer} ) ) {
  75         $line = shift @{$rlookahead_buffer};
  76     }
  77     else {
  78         $line = $line_source_object->get_line();
  79     }
  80     return $line;
  81 }
  82 1;
  83