"Fossies" - the Fresh Open Source Software Archive

Member "Perl-Tidy-20210717/lib/Perl/Tidy/LineSink.pm" (14 Jul 2021, 3618 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 "LineSink.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 # the Perl::Tidy::LineSink class supplies a write_line method for
    4 # actual file writing
    5 #
    6 #####################################################################
    7 
    8 package Perl::Tidy::LineSink;
    9 use strict;
   10 use warnings;
   11 our $VERSION = '20210717';
   12 
   13 sub AUTOLOAD {
   14 
   15     # Catch any undefined sub calls so that we are sure to get
   16     # some diagnostic information.  This sub should never be called
   17     # except for a programming error.
   18     our $AUTOLOAD;
   19     return if ( $AUTOLOAD =~ /\bDESTROY$/ );
   20     my ( $pkg, $fname, $lno ) = caller();
   21     my $my_package = __PACKAGE__;
   22     print STDERR <<EOM;
   23 ======================================================================
   24 Error detected in package '$my_package', version $VERSION
   25 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
   26 Called from package: '$pkg'  
   27 Called from File '$fname'  at line '$lno'
   28 This error is probably due to a recent programming change
   29 ======================================================================
   30 EOM
   31     exit 1;
   32 }
   33 
   34 sub DESTROY {
   35 
   36     # required to avoid call to AUTOLOAD in some versions of perl
   37 }
   38 
   39 sub new {
   40 
   41     my ( $class, @args ) = @_;
   42 
   43     my %defaults = (
   44         output_file              => undef,
   45         line_separator           => undef,
   46         rOpts                    => undef,
   47         rpending_logfile_message => undef,
   48         is_encoded_data          => undef,
   49     );
   50     my %args = ( %defaults, @args );
   51 
   52     my $output_file              = $args{output_file};
   53     my $line_separator           = $args{line_separator};
   54     my $rOpts                    = $args{rOpts};
   55     my $rpending_logfile_message = $args{rpending_logfile_message};
   56     my $is_encoded_data          = $args{is_encoded_data};
   57 
   58     my $fh = undef;
   59 
   60     my $output_file_open = 0;
   61 
   62     if ( $rOpts->{'format'} eq 'tidy' ) {
   63         ( $fh, $output_file ) =
   64           Perl::Tidy::streamhandle( $output_file, 'w', $is_encoded_data );
   65         unless ($fh) { Perl::Tidy::Die("Cannot write to output stream\n"); }
   66         $output_file_open = 1;
   67     }
   68 
   69     # in order to check output syntax when standard output is used,
   70     # or when it is an object, we have to make a copy of the file
   71     if ( $output_file eq '-' || ref $output_file ) {
   72         if ( $rOpts->{'check-syntax'} ) {
   73 
   74             # Turning off syntax check when standard output is used.
   75             # The reason is that temporary files cause problems on
   76             # on many systems.
   77             $rOpts->{'check-syntax'} = 0;
   78             ${$rpending_logfile_message} .= <<EOM;
   79 Note: --syntax check will be skipped because standard output is used
   80 EOM
   81 
   82         }
   83     }
   84 
   85     return bless {
   86         _fh               => $fh,
   87         _output_file      => $output_file,
   88         _output_file_open => $output_file_open,
   89         _line_separator   => $line_separator,
   90         _is_encoded_data  => $is_encoded_data,
   91     }, $class;
   92 }
   93 
   94 sub set_line_separator {
   95     my ( $self, $val ) = @_;
   96     $self->{_line_separator} = $val;
   97     return;
   98 }
   99 
  100 sub write_line {
  101 
  102     my ( $self, $line ) = @_;
  103     my $fh = $self->{_fh};
  104 
  105     my $line_separator = $self->{_line_separator};
  106     if ( defined($line_separator) ) {
  107         chomp $line;
  108         $line .= $line_separator;
  109     }
  110 
  111     $fh->print($line) if ( $self->{_output_file_open} );
  112 
  113     return;
  114 }
  115 
  116 sub close_output_file {
  117     my $self = shift;
  118 
  119     # Only close physical files, not STDOUT and other objects
  120     my $output_file = $self->{_output_file};
  121     if ( $output_file ne '-' && !ref $output_file ) {
  122         $self->{_fh}->close() if $self->{_output_file_open};
  123     }
  124     return;
  125 }
  126 
  127 1;