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