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 = '20181120';
  18
  19 sub new {
  20     my ( $package, $rarray, $mode ) = @_;
  21     my $ref = ref $rarray;
  22     if ( $ref ne 'ARRAY' ) {
  23         confess <<EOM;
  24 ------------------------------------------------------------------------
  25 expecting ref to ARRAY but got ref to ($ref); trace follows:
  26 ------------------------------------------------------------------------
  27 EOM
  28
  29     }
  30     if ( $mode eq 'w' ) {
  31         @{$rarray} = ();
  32         return bless [ $rarray, $mode ], $package;
  33     }
  34     elsif ( $mode eq 'r' ) {
  35         my $i_next = 0;
  36         return bless [ $rarray, $mode, $i_next ], $package;
  37     }
  38     else {
  39         confess <<EOM;
  40 ------------------------------------------------------------------------
  41 expecting mode = 'r' or 'w' but got mode ($mode); trace follows:
  42 ------------------------------------------------------------------------
  43 EOM
  44     }
  45 }
  46
  47 sub getline {
  48     my $self = shift;
  49     my $mode = $self->[1];
  50     if ( $mode ne 'r' ) {
  51         confess <<EOM;
  52 ------------------------------------------------------------------------
  53 getline requires mode = 'r' but mode = ($mode); trace follows:
  54 ------------------------------------------------------------------------
  55 EOM
  56     }
  57     my $i = $self->[2]++;
  58     return $self->[0]->[$i];
  59 }
  60
  61 sub print {
  62     my ( $self, $msg ) = @_;
  63     my $mode = $self->[1];
  64     if ( $mode ne 'w' ) {
  65         confess <<EOM;
  66 ------------------------------------------------------------------------
  67 print requires mode = 'w' but mode = ($mode); trace follows:
  68 ------------------------------------------------------------------------
  69 EOM
  70     }
  71     push @{ $self->[0] }, $msg;
  72     return;
  73 }
  74 sub close { return }
  75 1;
  76