1##################################################################### 2# 3# This is a stripped down version of IO::Scalar 4# Given a reference to a scalar, it supplies either: 5# a getline method which reads lines (mode='r'), or 6# a print method which reads lines (mode='w') 7# 8##################################################################### 9package Perl::Tidy::IOScalar; 10use strict; 11use warnings; 12use Carp; 13our $VERSION = '20211029'; 14 15sub AUTOLOAD { 16 17 # Catch any undefined sub calls so that we are sure to get 18 # some diagnostic information. This sub should never be called 19 # except for a programming error. 20 our $AUTOLOAD; 21 return if ( $AUTOLOAD =~ /\bDESTROY$/ ); 22 my ( $pkg, $fname, $lno ) = caller(); 23 my $my_package = __PACKAGE__; 24 print STDERR <<EOM; 25====================================================================== 26Error detected in package '$my_package', version $VERSION 27Received unexpected AUTOLOAD call for sub '$AUTOLOAD' 28Called from package: '$pkg' 29Called from File '$fname' at line '$lno' 30This error is probably due to a recent programming change 31====================================================================== 32EOM 33 exit 1; 34} 35 36sub DESTROY { 37 38 # required to avoid call to AUTOLOAD in some versions of perl 39} 40 41sub new { 42 my ( $package, $rscalar, $mode ) = @_; 43 my $ref = ref $rscalar; 44 if ( $ref ne 'SCALAR' ) { 45 confess <<EOM; 46------------------------------------------------------------------------ 47expecting ref to SCALAR but got ref to ($ref); trace follows: 48------------------------------------------------------------------------ 49EOM 50 51 } 52 if ( $mode eq 'w' ) { 53 ${$rscalar} = ""; 54 return bless [ $rscalar, $mode ], $package; 55 } 56 elsif ( $mode eq 'r' ) { 57 58 # Convert a scalar to an array. 59 # This avoids looking for "\n" on each call to getline 60 # 61 # NOTES: The -1 count is needed to avoid loss of trailing blank lines 62 # (which might be important in a DATA section). 63 my @array; 64 if ( $rscalar && ${$rscalar} ) { 65 66 #@array = map { $_ .= "\n" } split /\n/, ${$rscalar}, -1; 67 @array = map { $_ . "\n" } split /\n/, ${$rscalar}, -1; 68 69 # remove possible extra blank line introduced with split 70 if ( @array && $array[-1] eq "\n" ) { pop @array } 71 } 72 my $i_next = 0; 73 return bless [ \@array, $mode, $i_next ], $package; 74 } 75 else { 76 confess <<EOM; 77------------------------------------------------------------------------ 78expecting mode = 'r' or 'w' but got mode ($mode); trace follows: 79------------------------------------------------------------------------ 80EOM 81 } 82} 83 84sub getline { 85 my $self = shift; 86 my $mode = $self->[1]; 87 if ( $mode ne 'r' ) { 88 confess <<EOM; 89------------------------------------------------------------------------ 90getline call requires mode = 'r' but mode = ($mode); trace follows: 91------------------------------------------------------------------------ 92EOM 93 } 94 my $i = $self->[2]++; 95 return $self->[0]->[$i]; 96} 97 98sub print { 99 my ( $self, $msg ) = @_; 100 my $mode = $self->[1]; 101 if ( $mode ne 'w' ) { 102 confess <<EOM; 103------------------------------------------------------------------------ 104print call requires mode = 'w' but mode = ($mode); trace follows: 105------------------------------------------------------------------------ 106EOM 107 } 108 ${ $self->[0] } .= $msg; 109 return; 110} 111sub close { return } 1121; 113 114