1##################################################################### 2# 3# This is a stripped down version of IO::ScalarArray 4# Given a reference to an array, it supplies either: 5# a getline method which reads lines (mode='r'), or 6# a print method which reads lines (mode='w') 7# 8# NOTE: this routine assumes that there aren't any embedded 9# newlines within any of the array elements. There are no checks 10# for that. 11# 12##################################################################### 13package Perl::Tidy::IOScalarArray; 14use strict; 15use warnings; 16use Carp; 17our $VERSION = '20211029'; 18 19sub AUTOLOAD { 20 21 # Catch any undefined sub calls so that we are sure to get 22 # some diagnostic information. This sub should never be called 23 # except for a programming error. 24 our $AUTOLOAD; 25 return if ( $AUTOLOAD =~ /\bDESTROY$/ ); 26 my ( $pkg, $fname, $lno ) = caller(); 27 my $my_package = __PACKAGE__; 28 print STDERR <<EOM; 29====================================================================== 30Error detected in package '$my_package', version $VERSION 31Received unexpected AUTOLOAD call for sub '$AUTOLOAD' 32Called from package: '$pkg' 33Called from File '$fname' at line '$lno' 34This error is probably due to a recent programming change 35====================================================================== 36EOM 37 exit 1; 38} 39 40sub DESTROY { 41 42 # required to avoid call to AUTOLOAD in some versions of perl 43} 44 45sub new { 46 my ( $package, $rarray, $mode ) = @_; 47 my $ref = ref $rarray; 48 if ( $ref ne 'ARRAY' ) { 49 confess <<EOM; 50------------------------------------------------------------------------ 51expecting ref to ARRAY but got ref to ($ref); trace follows: 52------------------------------------------------------------------------ 53EOM 54 55 } 56 if ( $mode eq 'w' ) { 57 @{$rarray} = (); 58 return bless [ $rarray, $mode ], $package; 59 } 60 elsif ( $mode eq 'r' ) { 61 my $i_next = 0; 62 return bless [ $rarray, $mode, $i_next ], $package; 63 } 64 else { 65 confess <<EOM; 66------------------------------------------------------------------------ 67expecting mode = 'r' or 'w' but got mode ($mode); trace follows: 68------------------------------------------------------------------------ 69EOM 70 } 71} 72 73sub getline { 74 my $self = shift; 75 my $mode = $self->[1]; 76 if ( $mode ne 'r' ) { 77 confess <<EOM; 78------------------------------------------------------------------------ 79getline requires mode = 'r' but mode = ($mode); trace follows: 80------------------------------------------------------------------------ 81EOM 82 } 83 my $i = $self->[2]++; 84 return $self->[0]->[$i]; 85} 86 87sub print { 88 my ( $self, $msg ) = @_; 89 my $mode = $self->[1]; 90 if ( $mode ne 'w' ) { 91 confess <<EOM; 92------------------------------------------------------------------------ 93print requires mode = 'w' but mode = ($mode); trace follows: 94------------------------------------------------------------------------ 95EOM 96 } 97 push @{ $self->[0] }, $msg; 98 return; 99} 100sub close { return } 1011; 102 103