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 = '20220613';
  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;