"Fossies" - the Fresh Open Source Software Archive

Member "Perl-Tidy-20210717/lib/Perl/Tidy/IOScalarArray.pm" (14 Jul 2021, 3051 Bytes) of package /linux/misc/Perl-Tidy-20210717.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: 20210402_vs_20210717.

    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