1 #####################################################################
3 # The Perl::Tidy::Debugger class shows line tokenization
5 #####################################################################
7 package Perl::Tidy::Debugger;
10 use English qw( -no_match_vars );
11 our $VERSION = '20220613';
13 use constant EMPTY_STRING => q{};
14 use constant SPACE => q{ };
18 my ( $class, $filename, $is_encoded_data ) = @_;
21 _debug_file => $filename,
22 _debug_file_opened => 0,
24 _is_encoded_data => $is_encoded_data,
28 sub really_open_debug_file {
31 my $debug_file = $self->{_debug_file};
32 my $is_encoded_data = $self->{_is_encoded_data};
33 my ( $fh, $filename ) =
34 Perl::Tidy::streamhandle( $debug_file, 'w', $is_encoded_data );
36 Perl::Tidy::Warn("can't open $debug_file: $ERRNO\n");
38 $self->{_debug_file_opened} = 1;
41 "Use -dump-token-types (-dtt) to get a list of token type codes\n");
45 sub close_debug_file {
48 my $fh = $self->{_fh};
49 if ( $self->{_debug_file_opened} ) {
50 if ( !eval { $self->{_fh}->close(); 1 } ) {
52 # ok, maybe no close function
58 sub write_debug_entry {
60 # This is a debug dump routine which may be modified as necessary
61 # to dump tokens on a line-by-line basis. The output will be written
62 # to the .DEBUG file when the -D flag is entered.
63 my ( $self, $line_of_tokens ) = @_;
65 my $input_line = $line_of_tokens->{_line_text};
67 my $rtoken_type = $line_of_tokens->{_rtoken_type};
68 my $rtokens = $line_of_tokens->{_rtokens};
69 my $rlevels = $line_of_tokens->{_rlevels};
70 my $rblock_type = $line_of_tokens->{_rblock_type};
72 my $input_line_number = $line_of_tokens->{_line_number};
73 my $line_type = $line_of_tokens->{_line_type};
77 my $token_str = "$input_line_number: ";
78 my $reconstructed_original = "$input_line_number: ";
79 my $block_str = "$input_line_number: ";
81 my $pattern = EMPTY_STRING;
82 my @next_char = ( '"', '"' );
84 unless ( $self->{_debug_file_opened} ) { $self->really_open_debug_file() }
85 my $fh = $self->{_fh};
87 foreach my $j ( 0 .. @{$rtoken_type} - 1 ) {
90 if ( $rtoken_type->[$j] eq 'k' ) {
91 $pattern .= $rtokens->[$j];
94 $pattern .= $rtoken_type->[$j];
96 $reconstructed_original .= $rtokens->[$j];
97 $block_str .= "($rblock_type->[$j])";
98 $num = length( $rtokens->[$j] );
99 my $type_str = $rtoken_type->[$j];
101 # be sure there are no blank tokens (shouldn't happen)
102 # This can only happen if a programming error has been made
103 # because all valid tokens are non-blank
104 if ( $type_str eq SPACE ) {
105 $fh->print("BLANK TOKEN on the next line\n");
106 $type_str = $next_char[$i_next];
107 $i_next = 1 - $i_next;
110 if ( length($type_str) == 1 ) {
111 $type_str = $type_str x $num;
113 $token_str .= $type_str;
116 # Write what you want here ...
117 # $fh->print "$input_line\n";
118 # $fh->print "$pattern\n";
119 $fh->print("$reconstructed_original\n");
120 $fh->print("$token_str\n");