#!/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

