"Fossies" - the Fresh Open Source Software Archive

Member "Perl-Tidy-20200110/lib/Perl/Tidy/LineSink.pm" (7 Jan 2020, 3973 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 "LineSink.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 # 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 = '20200110';
   12 
   13 sub new {
   14 
   15     my ( $class, $output_file, $tee_file, $line_separator, $rOpts,
   16         $rpending_logfile_message, $binmode )
   17       = @_;
   18     my $fh     = undef;
   19     my $fh_tee = undef;
   20 
   21     my $output_file_open = 0;
   22 
   23     if ( $rOpts->{'format'} eq 'tidy' ) {
   24         ( $fh, $output_file ) = Perl::Tidy::streamhandle( $output_file, 'w' );
   25         unless ($fh) { Perl::Tidy::Die("Cannot write to output stream\n"); }
   26         $output_file_open = 1;
   27         if ($binmode) {
   28             if (   $rOpts->{'character-encoding'}
   29                 && $rOpts->{'character-encoding'} eq 'utf8' )
   30             {
   31                 if ( ref($fh) eq 'IO::File' ) {
   32                     $fh->binmode(":raw:encoding(UTF-8)");
   33                 }
   34                 elsif ( $output_file eq '-' ) {
   35                     binmode STDOUT, ":raw:encoding(UTF-8)";
   36                 }
   37             }
   38 
   39             # Patch for RT 122030
   40             elsif ( ref($fh) eq 'IO::File' ) { $fh->binmode(); }
   41 
   42             elsif ( $output_file eq '-' ) { binmode STDOUT }
   43         }
   44     }
   45 
   46     # in order to check output syntax when standard output is used,
   47     # or when it is an object, we have to make a copy of the file
   48     if ( $output_file eq '-' || ref $output_file ) {
   49         if ( $rOpts->{'check-syntax'} ) {
   50 
   51             # Turning off syntax check when standard output is used.
   52             # The reason is that temporary files cause problems on
   53             # on many systems.
   54             $rOpts->{'check-syntax'} = 0;
   55             ${$rpending_logfile_message} .= <<EOM;
   56 Note: --syntax check will be skipped because standard output is used
   57 EOM
   58 
   59         }
   60     }
   61 
   62     return bless {
   63         _fh               => $fh,
   64         _fh_tee           => $fh_tee,
   65         _output_file      => $output_file,
   66         _output_file_open => $output_file_open,
   67         _tee_flag         => 0,
   68         _tee_file         => $tee_file,
   69         _tee_file_opened  => 0,
   70         _line_separator   => $line_separator,
   71         _binmode          => $binmode,
   72     }, $class;
   73 }
   74 
   75 sub write_line {
   76 
   77     my ( $self, $line ) = @_;
   78     my $fh = $self->{_fh};
   79 
   80     my $output_file_open = $self->{_output_file_open};
   81     chomp $line;
   82     $line .= $self->{_line_separator};
   83 
   84     $fh->print($line) if ( $self->{_output_file_open} );
   85 
   86     if ( $self->{_tee_flag} ) {
   87         unless ( $self->{_tee_file_opened} ) { $self->really_open_tee_file() }
   88         my $fh_tee = $self->{_fh_tee};
   89         print $fh_tee $line;
   90     }
   91     return;
   92 }
   93 
   94 sub tee_on {
   95     my $self = shift;
   96     $self->{_tee_flag} = 1;
   97     return;
   98 }
   99 
  100 sub tee_off {
  101     my $self = shift;
  102     $self->{_tee_flag} = 0;
  103     return;
  104 }
  105 
  106 sub really_open_tee_file {
  107     my $self     = shift;
  108     my $tee_file = $self->{_tee_file};
  109     my $fh_tee;
  110     $fh_tee = IO::File->new(">$tee_file")
  111       or Perl::Tidy::Die("couldn't open TEE file $tee_file: $!\n");
  112     binmode $fh_tee if $self->{_binmode};
  113     $self->{_tee_file_opened} = 1;
  114     $self->{_fh_tee}          = $fh_tee;
  115     return;
  116 }
  117 
  118 sub close_output_file {
  119     my $self = shift;
  120 
  121     # Only close physical files, not STDOUT and other objects
  122     my $output_file = $self->{_output_file};
  123     if ( $output_file ne '-' && !ref $output_file ) {
  124         eval { $self->{_fh}->close() } if $self->{_output_file_open};
  125     }
  126     $self->close_tee_file();
  127     return;
  128 }
  129 
  130 sub close_tee_file {
  131     my $self = shift;
  132 
  133     # Only close physical files, not STDOUT and other objects
  134     if ( $self->{_tee_file_opened} ) {
  135         my $tee_file = $self->{_tee_file};
  136         if ( $tee_file ne '-' && !ref $tee_file ) {
  137             eval { $self->{_fh_tee}->close() };
  138             $self->{_tee_file_opened} = 0;
  139         }
  140     }
  141     return;
  142 }
  143 
  144 1;
  145