lib/Perl/Tidy/IOScalar.pm

   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 #####################################################################
   9 package Perl::Tidy::IOScalar;
  10 use strict;
  11 use warnings;
  12 use Carp;
  13 our $VERSION = '20181120';
  14
  15 sub new {
  16     my ( $package, $rscalar, $mode ) = @_;
  17     my $ref = ref $rscalar;
  18     if ( $ref ne 'SCALAR' ) {
  19         confess <<EOM;
  20 ------------------------------------------------------------------------
  21 expecting ref to SCALAR but got ref to ($ref); trace follows:
  22 ------------------------------------------------------------------------
  23 EOM
  24
  25     }
  26     if ( $mode eq 'w' ) {
  27         ${$rscalar} = "";
  28         return bless [ $rscalar, $mode ], $package;
  29     }
  30     elsif ( $mode eq 'r' ) {
  31
  32         # Convert a scalar to an array.
  33         # This avoids looking for "\n" on each call to getline
  34         #
  35         # NOTES: The -1 count is needed to avoid loss of trailing blank lines
  36         # (which might be important in a DATA section).
  37         my @array;
  38         if ( $rscalar && ${$rscalar} ) {
  39
  40             #@array = map { $_ .= "\n" } split /\n/, ${$rscalar}, -1;
  41             @array = map { $_ . "\n" } split /\n/, ${$rscalar}, -1;
  42
  43             # remove possible extra blank line introduced with split
  44             if ( @array && $array[-1] eq "\n" ) { pop @array }
  45         }
  46         my $i_next = 0;
  47         return bless [ \@array, $mode, $i_next ], $package;
  48     }
  49     else {
  50         confess <<EOM;
  51 ------------------------------------------------------------------------
  52 expecting mode = 'r' or 'w' but got mode ($mode); trace follows:
  53 ------------------------------------------------------------------------
  54 EOM
  55     }
  56 }
  57
  58 sub getline {
  59     my $self = shift;
  60     my $mode = $self->[1];
  61     if ( $mode ne 'r' ) {
  62         confess <<EOM;
  63 ------------------------------------------------------------------------
  64 getline call requires mode = 'r' but mode = ($mode); trace follows:
  65 ------------------------------------------------------------------------
  66 EOM
  67     }
  68     my $i = $self->[2]++;
  69     return $self->[0]->[$i];
  70 }
  71
  72 sub print {
  73     my ( $self, $msg ) = @_;
  74     my $mode = $self->[1];
  75     if ( $mode ne 'w' ) {
  76         confess <<EOM;
  77 ------------------------------------------------------------------------
  78 print call requires mode = 'w' but mode = ($mode); trace follows:
  79 ------------------------------------------------------------------------
  80 EOM
  81     }
  82     ${ $self->[0] } .= $msg;
  83     return;
  84 }
  85 sub close { return }
  86 1;
  87