New upstream version 20210717

[perltidy.git] / lib / Perl / Tidy / LineSink.pm

diff --git a/lib/Perl/Tidy/LineSink.pm b/lib/Perl/Tidy/LineSink.pm
index 51a68268840e9831be482970ef52d27e3f8c64f5..a3cee83ed3c2bb3bef812aec25f2734be1bac268 100644 (file)
--- a/lib/Perl/Tidy/LineSink.pm
+++ b/lib/Perl/Tidy/LineSink.pm
@@ -8,39 +8,62 @@
 package Perl::Tidy::LineSink;
 use strict;
 use warnings;
-our $VERSION = '20200110';
+our $VERSION = '20210717';
+
+sub AUTOLOAD {
+
+    # Catch any undefined sub calls so that we are sure to get
+    # some diagnostic information.  This sub should never be called
+    # except for a programming error.
+    our $AUTOLOAD;
+    return if ( $AUTOLOAD =~ /\bDESTROY$/ );
+    my ( $pkg, $fname, $lno ) = caller();
+    my $my_package = __PACKAGE__;
+    print STDERR <<EOM;
+======================================================================
+Error detected in package '$my_package', version $VERSION
+Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
+Called from package: '$pkg'  
+Called from File '$fname'  at line '$lno'
+This error is probably due to a recent programming change
+======================================================================
+EOM
+    exit 1;
+}
+
+sub DESTROY {
+
+    # required to avoid call to AUTOLOAD in some versions of perl
+}
 
 sub new {
 
-    my ( $class, $output_file, $tee_file, $line_separator, $rOpts,
-        $rpending_logfile_message, $binmode )
-      = @_;
-    my $fh     = undef;
-    my $fh_tee = undef;
+    my ( $class, @args ) = @_;
+
+    my %defaults = (
+        output_file              => undef,
+        line_separator           => undef,
+        rOpts                    => undef,
+        rpending_logfile_message => undef,
+        is_encoded_data          => undef,
+    );
+    my %args = ( %defaults, @args );
+
+    my $output_file              = $args{output_file};
+    my $line_separator           = $args{line_separator};
+    my $rOpts                    = $args{rOpts};
+    my $rpending_logfile_message = $args{rpending_logfile_message};
+    my $is_encoded_data          = $args{is_encoded_data};
+
+    my $fh = undef;
 
     my $output_file_open = 0;
 
     if ( $rOpts->{'format'} eq 'tidy' ) {
-        ( $fh, $output_file ) = Perl::Tidy::streamhandle( $output_file, 'w' );
+        ( $fh, $output_file ) =
+          Perl::Tidy::streamhandle( $output_file, 'w', $is_encoded_data );
         unless ($fh) { Perl::Tidy::Die("Cannot write to output stream\n"); }
         $output_file_open = 1;
-        if ($binmode) {
-            if (   $rOpts->{'character-encoding'}
-                && $rOpts->{'character-encoding'} eq 'utf8' )
-            {
-                if ( ref($fh) eq 'IO::File' ) {
-                    $fh->binmode(":raw:encoding(UTF-8)");
-                }
-                elsif ( $output_file eq '-' ) {
-                    binmode STDOUT, ":raw:encoding(UTF-8)";
-                }
-            }
-
-            # Patch for RT 122030
-            elsif ( ref($fh) eq 'IO::File' ) { $fh->binmode(); }
-
-            elsif ( $output_file eq '-' ) { binmode STDOUT }
-        }
     }
 
     # in order to check output syntax when standard output is used,
@@ -61,57 +84,32 @@ EOM
 
     return bless {
         _fh               => $fh,
-        _fh_tee           => $fh_tee,
         _output_file      => $output_file,
         _output_file_open => $output_file_open,
-        _tee_flag         => 0,
-        _tee_file         => $tee_file,
-        _tee_file_opened  => 0,
         _line_separator   => $line_separator,
-        _binmode          => $binmode,
+        _is_encoded_data  => $is_encoded_data,
     }, $class;
 }
 
+sub set_line_separator {
+    my ( $self, $val ) = @_;
+    $self->{_line_separator} = $val;
+    return;
+}
+
 sub write_line {
 
     my ( $self, $line ) = @_;
     my $fh = $self->{_fh};
 
-    my $output_file_open = $self->{_output_file_open};
-    chomp $line;
-    $line .= $self->{_line_separator};
-
-    $fh->print($line) if ( $self->{_output_file_open} );
-
-    if ( $self->{_tee_flag} ) {
-        unless ( $self->{_tee_file_opened} ) { $self->really_open_tee_file() }
-        my $fh_tee = $self->{_fh_tee};
-        print $fh_tee $line;
+    my $line_separator = $self->{_line_separator};
+    if ( defined($line_separator) ) {
+        chomp $line;
+        $line .= $line_separator;
     }
-    return;
-}
 
-sub tee_on {
-    my $self = shift;
-    $self->{_tee_flag} = 1;
-    return;
-}
-
-sub tee_off {
-    my $self = shift;
-    $self->{_tee_flag} = 0;
-    return;
-}
+    $fh->print($line) if ( $self->{_output_file_open} );
 
-sub really_open_tee_file {
-    my $self     = shift;
-    my $tee_file = $self->{_tee_file};
-    my $fh_tee;
-    $fh_tee = IO::File->new(">$tee_file")
-      or Perl::Tidy::Die("couldn't open TEE file $tee_file: $!\n");
-    binmode $fh_tee if $self->{_binmode};
-    $self->{_tee_file_opened} = 1;
-    $self->{_fh_tee}          = $fh_tee;
     return;
 }
 
@@ -121,25 +119,9 @@ sub close_output_file {
     # Only close physical files, not STDOUT and other objects
     my $output_file = $self->{_output_file};
     if ( $output_file ne '-' && !ref $output_file ) {
-        eval { $self->{_fh}->close() } if $self->{_output_file_open};
-    }
-    $self->close_tee_file();
-    return;
-}
-
-sub close_tee_file {
-    my $self = shift;
-
-    # Only close physical files, not STDOUT and other objects
-    if ( $self->{_tee_file_opened} ) {
-        my $tee_file = $self->{_tee_file};
-        if ( $tee_file ne '-' && !ref $tee_file ) {
-            eval { $self->{_fh_tee}->close() };
-            $self->{_tee_file_opened} = 0;
-        }
+        $self->{_fh}->close() if $self->{_output_file_open};
     }
     return;
 }
 
 1;
-