1 #####################################################################
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')
8 #####################################################################
9 package Perl::Tidy::IOScalar;
13 our $VERSION = '20220217';
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.
21 return if ( $AUTOLOAD =~ /\bDESTROY$/ );
22 my ( $pkg, $fname, $lno ) = caller();
23 my $my_package = __PACKAGE__;
25 ======================================================================
26 Error detected in package '$my_package', version $VERSION
27 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
28 Called from package: '$pkg'
29 Called from File '$fname' at line '$lno'
30 This error is probably due to a recent programming change
31 ======================================================================
38 # required to avoid call to AUTOLOAD in some versions of perl
42 my ( $package, $rscalar, $mode ) = @_;
43 my $ref = ref $rscalar;
44 if ( $ref ne 'SCALAR' ) {
46 ------------------------------------------------------------------------
47 expecting ref to SCALAR but got ref to ($ref); trace follows:
48 ------------------------------------------------------------------------
54 return bless [ $rscalar, $mode ], $package;
56 elsif ( $mode eq 'r' ) {
58 # Convert a scalar to an array.
59 # This avoids looking for "\n" on each call to getline
61 # NOTES: The -1 count is needed to avoid loss of trailing blank lines
62 # (which might be important in a DATA section).
64 if ( $rscalar && ${$rscalar} ) {
66 #@array = map { $_ .= "\n" } split /\n/, ${$rscalar}, -1;
67 @array = map { $_ . "\n" } split /\n/, ${$rscalar}, -1;
69 # remove possible extra blank line introduced with split
70 if ( @array && $array[-1] eq "\n" ) { pop @array }
73 return bless [ \@array, $mode, $i_next ], $package;
77 ------------------------------------------------------------------------
78 expecting mode = 'r' or 'w' but got mode ($mode); trace follows:
79 ------------------------------------------------------------------------
86 my $mode = $self->[1];
89 ------------------------------------------------------------------------
90 getline call requires mode = 'r' but mode = ($mode); trace follows:
91 ------------------------------------------------------------------------
95 return $self->[0]->[$i];
99 my ( $self, $msg ) = @_;
100 my $mode = $self->[1];
101 if ( $mode ne 'w' ) {
103 ------------------------------------------------------------------------
104 print call requires mode = 'w' but mode = ($mode); trace follows:
105 ------------------------------------------------------------------------
108 ${ $self->[0] } .= $msg;