Generated: Tue Feb 2 17:54:39 2010 from gendbgcode.pl 2008/08/02 8.9 KB.
#!/perl -w # NAME: gendbgcode.pl # AIM: Add DEBUG to a C/C++ code file # 01/08/2008 geoff mclane http://geoffair.net/mperl use strict; use warnings; require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = "temp.$pgmname.txt"; open_log($outfile); prt( "$0 ... Hello, World ...\n" ); my $minwid = 90; use constant { TYP_CODE => 1, TYP_TYPD => 2, TYP_HASH => 3, TYP_MACRO => 4, }; my %strings = ( 1 => 'CODE', 2 => 'TYPD', 3 => 'HASH', 4 => 'MACRO', ); #my $in_file = "C:\\Projects\\Tidy\\tidy4p5\\src\\tidylib.c"; my $in_file = "C:\\Projects\\Tidy\\twperl\\tidyperl.cpp"; ##my $in_file = "temptest.c"; # debug my $dbg1 = 1; # show type in output process_file($in_file); close_log($outfile,0); exit(0); ################################## sub C_comment_starts { my ($txt) = shift; my $len = length($txt); my $ptxt = ''; my $ttxt = ''; my ($k, $ch, $pch, $k2, $nch); for ($k = 0; $k < $len; $k++) { $k2 = $k + 1; $ch = substr($txt,$k,1); $nch = (($k2 < $len) ? substr($txt,$k2,1) : ''); if (($ch eq '/')&&($nch eq '*')) { $ttxt = substr($txt,($k2+1)); return $k2, $ptxt, $ttxt; # return offset, previous and begin comment } $pch = $ch; $ptxt .= $ch; } return 0, $ptxt, $ttxt; } sub inline_comment_starts { my ($txt) = shift; my $len = length($txt); my $ptxt = ''; my ($k, $ch, $pch, $k2, $nch); for ($k = 0; $k < $len; $k++) { $k2 = $k + 1; $ch = substr($txt,$k,1); $nch = (($k2 < $len) ? substr($txt,$k2,1) : ''); if (($ch eq '/')&&($nch eq '/')) { return $k2, $ptxt; # return offset, previous } $pch = $ch; $ptxt .= $ch; } return 0, $ptxt; } sub C_comment_ends { my ($txt) = shift; my $len = length($txt); my $ttxt = ''; my ($k, $ch, $pch, $k2, $nch); for ($k = 0; $k < $len; $k++) { $k2 = $k + 1; $ch = substr($txt,$k,1); $nch = (($k2 < $len) ? substr($txt,$k2,1) : ''); if (($ch eq '*')&&($nch eq '/')) { $ttxt = substr($txt,($k2+1)); return $k2, $ttxt; # return trailing } $pch = $ch; } return 0, $ttxt; } sub process_file { my ($inf) = shift; my (@lines, $lncnt, $line, $tline); my ($isc, $ptxt, $i, $ttxt, $ise, $atxt, $i2, $ctxt); my $incomm = 0; my $lnnum = 0; my ($typ, $inmacro, $len, $ch, $j, $braces, $pbrac); my ($msg); my @nlines = (); $inmacro = 0; $braces = 0; $pbrac = 0; if (open INF, "<$inf") { @lines = <INF>; close INF; $lncnt = scalar @lines; prt( "Processing $lncnt lines, from $inf ...\n"); for ($i = 0; $i < $lncnt; $i++) { $lnnum++; $line = $lines[$i]; $tline = trim_all($line); if ($incomm) { ($ise,$atxt) = C_comment_ends($tline); if ($ise) { $msg = "$lnnum: Comment ends"; $msg .= " [$atxt] follows" if length($atxt); prt( "$msg\n" ); $incomm = 0; $tline = trim_all($atxt); } } if (! $incomm) { $ctxt = $tline; ($isc,$ptxt,$ttxt) = C_comment_starts($tline); if ($isc) { # deal with any $ptxt .. ($ise,$atxt) = C_comment_ends($ttxt); if ($ise) { while ($isc && $ise) { $ptxt = trim_all($ptxt); $atxt = trim_all($atxt); $ctxt = $ptxt; $ctxt .= ' ' if (length($ctxt) && length($atxt) && ($atxt ne ';')); $ctxt .= $atxt if length($atxt); $ctxt = trim_all($ctxt); $msg = "$lnnum: Comment starts/ends - "; $msg .= "[$ptxt] before " if length($ptxt); $msg .= "[$atxt] follows " if length($atxt); prt( "$msg\n" ); ($isc,$ptxt,$ttxt) = C_comment_starts($ctxt); $atxt = ''; if ($isc) { ($ise,$atxt) = C_comment_ends($ttxt); } $ptxt = trim_all($ptxt); $atxt = trim_all($atxt); $ctxt = $ptxt; $ctxt .= ' ' if (length($ctxt) && length($atxt) && ($atxt ne ';')); ###$ctxt .= ' ' if length($ctxt); $ctxt .= $atxt if length($atxt); $ctxt = trim_all($ctxt); } } else { $ctxt = trim_all($ptxt); $msg = "$lnnum: IN Comment"; $msg .= " after [$ptxt]" if length($ptxt); prt( "$msg\n" ); $incomm = 1; } } $tline = $ctxt; if (! $incomm) { ($isc,$ptxt) = inline_comment_starts($tline); if ($isc) { $ctxt = trim_all($ptxt); $msg = "$lnnum: INLINE Comment"; $msg .= " after [$ptxt]" if length($ptxt); prt( "$msg\n" ); } else { $ctxt = $tline; } } } if (length($ctxt)) { $typ = TYP_CODE; if ($inmacro) { $typ = TYP_MACRO; if ( !($ctxt =~ /\\$/) ) { $inmacro = 0; } } elsif ($ctxt =~ /^#/) { $typ = TYP_HASH; if ($ctxt =~ /\\$/) { $typ = TYP_MACRO; $inmacro = 1; } } elsif ($ctxt =~ /^typedef\s+/) { $typ = TYP_TYPD; } if (($typ == TYP_CODE)||($typ == TYP_TYPD)) { $len = length($ctxt); for ($j = 0; $j < $len; $j++) { $ch = substr($ctxt,$j,1); if ($ch eq '{') { $braces++; } elsif ($ch eq '}') { $braces--; } } } # num type text braces # 0 1 2 3 push(@nlines,[$i, $typ, $ctxt, $braces]); } } prt( "Done $lncnt lines, from $inf ...\n"); $lncnt = scalar @nlines; prt( "Got $lncnt new lines...\n"); $atxt = ''; $pbrac = -1; for ($i = 0; $i < $lncnt; $i++) { # num type text braces # 0 1 2 3 #push(@nlines,[$i, $typ, $ctxt, $braces]); $lnnum = $nlines[$i][0]; $typ = $nlines[$i][1]; $ctxt = $nlines[$i][2]; $braces = $nlines[$i][3]; if ($dbg1) { $ptxt = $strings{$typ}.": $ctxt"; if ($braces != $pbrac) { if ($braces > $pbrac) { $atxt .= "\n"; # start a NEW line } while (length($ptxt) < $minwid) { $ptxt .= ' '; } if ($pbrac > $braces) { $ptxt .= " [$pbrac:$braces]"; } else { $ptxt .= " [$braces]"; } $pbrac = $braces; } else { if ($ctxt =~ /\}$/) { while (length($ptxt) < $minwid) { $ptxt .= ' '; } $ptxt .= " [$braces]="; } } $ptxt .= "\n"; $atxt .= $ptxt; } else { $atxt .= "$ctxt\n"; } } write2file($atxt, 'tempnew.txt'); prt( "Written to tempnew.txt file ...\n"); system ( 'tempnew.txt' ); } else { prt( "ERROR: Failed to open $inf ... $! ...\n" ); } } # eof - gendbgcode.pl