lib/Perl/Tidy/LineSink.pm

   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 = '20181120';
  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(":encoding(UTF-8)");
  33                 }
  34                 elsif ( $output_file eq '-' ) {
  35                     binmode STDOUT, ":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