"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.

    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