"Fossies" - the Fresh Open Source Software Archive

Member "Perl-Tidy-20200110/lib/Perl/Tidy/IOScalar.pm" (7 Jan 2020, 2668 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 "IOScalar.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::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 = '20200110';
   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