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 = '20221112';
15 use constant EMPTY_STRING => q{};
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.
23 return if ( $AUTOLOAD =~ /\bDESTROY$/ );
24 my ( $pkg, $fname, $lno ) = caller();
25 my $my_package = __PACKAGE__;
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 ======================================================================
40 # required to avoid call to AUTOLOAD in some versions of perl
44 my ( $package, $rscalar, $mode ) = @_;
45 my $ref = ref $rscalar;
46 if ( $ref ne 'SCALAR' ) {
48 ------------------------------------------------------------------------
49 expecting ref to SCALAR but got ref to ($ref); trace follows:
50 ------------------------------------------------------------------------
55 ${$rscalar} = EMPTY_STRING;
56 return bless [ $rscalar, $mode ], $package;
58 elsif ( $mode eq 'r' ) {
60 # Convert a scalar to an array.
61 # This avoids looking for "\n" on each call to getline
63 # NOTES: The -1 count is needed to avoid loss of trailing blank lines
64 # (which might be important in a DATA section).
66 if ( $rscalar && ${$rscalar} ) {
68 #@array = map { $_ .= "\n" } split /\n/, ${$rscalar}, -1;
69 @array = map { $_ . "\n" } split /\n/, ${$rscalar}, -1;
71 # remove possible extra blank line introduced with split
72 if ( @array && $array[-1] eq "\n" ) { pop @array }
75 return bless [ \@array, $mode, $i_next ], $package;
79 ------------------------------------------------------------------------
80 expecting mode = 'r' or 'w' but got mode ($mode); trace follows:
81 ------------------------------------------------------------------------
88 my $mode = $self->[1];
91 ------------------------------------------------------------------------
92 getline call requires mode = 'r' but mode = ($mode); trace follows:
93 ------------------------------------------------------------------------
97 return $self->[0]->[$i];
101 my ( $self, $msg ) = @_;
102 my $mode = $self->[1];
103 if ( $mode ne 'w' ) {
105 ------------------------------------------------------------------------
106 print call requires mode = 'w' but mode = ($mode); trace follows:
107 ------------------------------------------------------------------------
110 ${ $self->[0] } .= $msg;