lib/Perl/Tidy/IOScalarArray.pm

   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 #####################################################################
  13 package Perl::Tidy::IOScalarArray;
  14 use strict;
  15 use warnings;
  16 use Carp;
  17 our $VERSION = '20210717';
  18
  19 sub 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 ======================================================================
  30 Error detected in package '$my_package', version $VERSION
  31 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
  32 Called from package: '$pkg'
  33 Called from File '$fname'  at line '$lno'
  34 This error is probably due to a recent programming change
  35 ======================================================================
  36 EOM
  37     exit 1;
  38 }
  39
  40 sub DESTROY {
  41
  42     # required to avoid call to AUTOLOAD in some versions of perl
  43 }
  44
  45 sub new {
  46     my ( $package, $rarray, $mode ) = @_;
  47     my $ref = ref $rarray;
  48     if ( $ref ne 'ARRAY' ) {
  49         confess <<EOM;
  50 ------------------------------------------------------------------------
  51 expecting ref to ARRAY but got ref to ($ref); trace follows:
  52 ------------------------------------------------------------------------
  53 EOM
  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 ------------------------------------------------------------------------
  67 expecting mode = 'r' or 'w' but got mode ($mode); trace follows:
  68 ------------------------------------------------------------------------
  69 EOM
  70     }
  71 }
  72
  73 sub getline {
  74     my $self = shift;
  75     my $mode = $self->[1];
  76     if ( $mode ne 'r' ) {
  77         confess <<EOM;
  78 ------------------------------------------------------------------------
  79 getline requires mode = 'r' but mode = ($mode); trace follows:
  80 ------------------------------------------------------------------------
  81 EOM
  82     }
  83     my $i = $self->[2]++;
  84     return $self->[0]->[$i];
  85 }
  86
  87 sub print {
  88     my ( $self, $msg ) = @_;
  89     my $mode = $self->[1];
  90     if ( $mode ne 'w' ) {
  91         confess <<EOM;
  92 ------------------------------------------------------------------------
  93 print requires mode = 'w' but mode = ($mode); trace follows:
  94 ------------------------------------------------------------------------
  95 EOM
  96     }
  97     push @{ $self->[0] }, $msg;
  98     return;
  99 }
 100 sub close { return }
 101 1;
 102