New upstream version 20230309

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

diff --git a/lib/Perl/Tidy/Debugger.pm b/lib/Perl/Tidy/Debugger.pm
index 2fe1bbb07a5ba8694a232f2a3109cae74b4f4975..457da0d53bbedc2d35266073a24ddd776faf8bf1 100644 (file)
--- a/lib/Perl/Tidy/Debugger.pm
+++ b/lib/Perl/Tidy/Debugger.pm
@@ -7,38 +7,44 @@
 package Perl::Tidy::Debugger;
 use strict;
 use warnings;
-our $VERSION = '20190601';
+use English qw( -no_match_vars );
+our $VERSION = '20230309';
+
+use constant EMPTY_STRING => q{};
+use constant SPACE        => q{ };
 
 sub new {
 
-    my ( $class, $filename ) = @_;
+    my ( $class, $filename, $is_encoded_data ) = @_;
 
     return bless {
         _debug_file        => $filename,
         _debug_file_opened => 0,
         _fh                => undef,
+        _is_encoded_data   => $is_encoded_data,
     }, $class;
-}
+} ## end sub new
 
 sub really_open_debug_file {
 
-    my $self       = shift;
-    my $debug_file = $self->{_debug_file};
-    my $fh;
-    unless ( $fh = IO::File->new("> $debug_file") ) {
-        Perl::Tidy::Warn("can't open $debug_file: $!\n");
+    my $self            = shift;
+    my $debug_file      = $self->{_debug_file};
+    my $is_encoded_data = $self->{_is_encoded_data};
+    my ( $fh, $filename ) =
+      Perl::Tidy::streamhandle( $debug_file, 'w', $is_encoded_data );
+    if ( !$fh ) {
+        Perl::Tidy::Warn("can't open $debug_file: $ERRNO\n");
     }
     $self->{_debug_file_opened} = 1;
     $self->{_fh}                = $fh;
-    print $fh
-      "Use -dump-token-types (-dtt) to get a list of token type codes\n";
+    $fh->print(
+        "Use -dump-token-types (-dtt) to get a list of token type codes\n");
     return;
-}
+} ## end sub really_open_debug_file
 
 sub close_debug_file {
 
     my $self = shift;
-    my $fh   = $self->{_fh};
     if ( $self->{_debug_file_opened} ) {
         if ( !eval { $self->{_fh}->close(); 1 } ) {
 
@@ -46,7 +52,7 @@ sub close_debug_file {
         }
     }
     return;
-}
+} ## end sub close_debug_file
 
 sub write_debug_entry {
 
@@ -60,29 +66,21 @@ sub write_debug_entry {
     my $rtoken_type = $line_of_tokens->{_rtoken_type};
     my $rtokens     = $line_of_tokens->{_rtokens};
     my $rlevels     = $line_of_tokens->{_rlevels};
-    my $rslevels    = $line_of_tokens->{_rslevels};
-    my $rblock_type = $line_of_tokens->{_rblock_type};
 
     my $input_line_number = $line_of_tokens->{_line_number};
     my $line_type         = $line_of_tokens->{_line_type};
-    ##my $rtoken_array      = $line_of_tokens->{_token_array};
 
     my ( $j, $num );
 
     my $token_str              = "$input_line_number: ";
     my $reconstructed_original = "$input_line_number: ";
-    my $block_str              = "$input_line_number: ";
-
-    #$token_str .= "$line_type: ";
-    #$reconstructed_original .= "$line_type: ";
 
-    my $pattern   = "";
+    my $pattern   = EMPTY_STRING;
     my @next_char = ( '"', '"' );
     my $i_next    = 0;
     unless ( $self->{_debug_file_opened} ) { $self->really_open_debug_file() }
     my $fh = $self->{_fh};
 
-    # FIXME: could convert to use of token_array instead
     foreach my $j ( 0 .. @{$rtoken_type} - 1 ) {
 
         # testing patterns
@@ -93,15 +91,14 @@ sub write_debug_entry {
             $pattern .= $rtoken_type->[$j];
         }
         $reconstructed_original .= $rtokens->[$j];
-        $block_str              .= "($rblock_type->[$j])";
         $num = length( $rtokens->[$j] );
         my $type_str = $rtoken_type->[$j];
 
         # be sure there are no blank tokens (shouldn't happen)
         # This can only happen if a programming error has been made
         # because all valid tokens are non-blank
-        if ( $type_str eq ' ' ) {
-            print $fh "BLANK TOKEN on the next line\n";
+        if ( $type_str eq SPACE ) {
+            $fh->print("BLANK TOKEN on the next line\n");
             $type_str = $next_char[$i_next];
             $i_next   = 1 - $i_next;
         }
@@ -113,13 +110,11 @@ sub write_debug_entry {
     }
 
     # Write what you want here ...
-    # print $fh "$input_line\n";
-    # print $fh "$pattern\n";
-    print $fh "$reconstructed_original\n";
-    print $fh "$token_str\n";
+    # $fh->print "$input_line\n";
+    # $fh->print "$pattern\n";
+    $fh->print("$reconstructed_original\n");
+    $fh->print("$token_str\n");
 
-    #print $fh "$block_str\n";
     return;
-}
+} ## end sub write_debug_entry
 1;
-