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