1 #####################################################################
3 # The Perl::Tidy::Debugger class shows line tokenization
5 #####################################################################
7 package Perl::Tidy::Debugger;
10 our $VERSION = '20200110';
14 my ( $class, $filename ) = @_;
17 _debug_file => $filename,
18 _debug_file_opened => 0,
23 sub really_open_debug_file {
26 my $debug_file = $self->{_debug_file};
28 unless ( $fh = IO::File->new("> $debug_file") ) {
29 Perl::Tidy::Warn("can't open $debug_file: $!\n");
31 $self->{_debug_file_opened} = 1;
34 "Use -dump-token-types (-dtt) to get a list of token type codes\n";
38 sub close_debug_file {
41 my $fh = $self->{_fh};
42 if ( $self->{_debug_file_opened} ) {
43 if ( !eval { $self->{_fh}->close(); 1 } ) {
45 # ok, maybe no close function
51 sub write_debug_entry {
53 # This is a debug dump routine which may be modified as necessary
54 # to dump tokens on a line-by-line basis. The output will be written
55 # to the .DEBUG file when the -D flag is entered.
56 my ( $self, $line_of_tokens ) = @_;
58 my $input_line = $line_of_tokens->{_line_text};
60 my $rtoken_type = $line_of_tokens->{_rtoken_type};
61 my $rtokens = $line_of_tokens->{_rtokens};
62 my $rlevels = $line_of_tokens->{_rlevels};
63 my $rslevels = $line_of_tokens->{_rslevels};
64 my $rblock_type = $line_of_tokens->{_rblock_type};
66 my $input_line_number = $line_of_tokens->{_line_number};
67 my $line_type = $line_of_tokens->{_line_type};
68 ##my $rtoken_array = $line_of_tokens->{_token_array};
72 my $token_str = "$input_line_number: ";
73 my $reconstructed_original = "$input_line_number: ";
74 my $block_str = "$input_line_number: ";
76 #$token_str .= "$line_type: ";
77 #$reconstructed_original .= "$line_type: ";
80 my @next_char = ( '"', '"' );
82 unless ( $self->{_debug_file_opened} ) { $self->really_open_debug_file() }
83 my $fh = $self->{_fh};
85 # FIXME: could convert to use of token_array instead
86 foreach my $j ( 0 .. @{$rtoken_type} - 1 ) {
89 if ( $rtoken_type->[$j] eq 'k' ) {
90 $pattern .= $rtokens->[$j];
93 $pattern .= $rtoken_type->[$j];
95 $reconstructed_original .= $rtokens->[$j];
96 $block_str .= "($rblock_type->[$j])";
97 $num = length( $rtokens->[$j] );
98 my $type_str = $rtoken_type->[$j];
100 # be sure there are no blank tokens (shouldn't happen)
101 # This can only happen if a programming error has been made
102 # because all valid tokens are non-blank
103 if ( $type_str eq ' ' ) {
104 print $fh "BLANK TOKEN on the next line\n";
105 $type_str = $next_char[$i_next];
106 $i_next = 1 - $i_next;
109 if ( length($type_str) == 1 ) {
110 $type_str = $type_str x $num;
112 $token_str .= $type_str;
115 # Write what you want here ...
116 # print $fh "$input_line\n";
117 # print $fh "$pattern\n";
118 print $fh "$reconstructed_original\n";
119 print $fh "$token_str\n";
121 #print $fh "$block_str\n";