"Fossies" - the Fresh Open Source Software Archive

Member "Perl-Tidy-20200110/lib/Perl/Tidy/IOScalarArray.pm" (7 Jan 2020, 2215 Bytes) of package /linux/misc/Perl-Tidy-20200110.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "IOScalarArray.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 20191203_vs_20200110.

    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 = '20200110';
   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