#!/usr/bin/perl -w
# NAME: lib_srcscan.pl - library
# AIM: Read a C/C++ file, check for main(), and other things...
# Params:
# 1 - required - Source file name to scan
# 2 - optional - BIT Options, for output mainly
# 06/03/2011 - FIX20110306 - add MORE diagnostic concerning #if... parsing
# 19/09/2010 - Make this lib_srcscan.pl, and only retain the chkmain2, now called src_scan
# 2010-07-07 - Some tidying when used in makesrcs.pl
# 20090911 - version 2 with output indicator
# 20090828 - check for quotes "...", and only WARN if could have been in quotes
# 21/11/2007 - geoff mclane - http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )

sub src_scan {
    my $fil = shift;
    my $opts = (@_) ? shift : 0;
    my ($ccnt, $pline, $j, $k, $k2, $ch, $pch, $cline, $tline, $ll, $incomm, $tag, $fnd1, $comment);
    my ($lncomm, $wascomm, $hadquotes, $quoted, $wd, $minq, $lnn, $intest);
    my ($inc,$fndit,$qc,$tmp,$tmpc);
    my @ifstack = ();
    my @allifs = (); # FIX20110306 - only for diagnostics
    my @includes = ();
    my %results = ();
    my $fndm = 0;
    $fndit = 0;
    $ccnt = 0;
    if (!open INF, "<$fil") {
        prtw( "WARNING: Unable to open [$fil] file ... $! ...\n" ) if ($opts);
        $results{'LINE_COUNT'} = $ccnt;
        $results{'MAIN_COUNT'} = $fndm;
        $results{'MAIN_OTHER'} = $fndit;
        $results{'INCLUDES'} = \@includes;
        return \%results;
    }
    my @clines = <INF>;
    close INF;
    $ccnt = scalar @clines;
    $pline = '';
    $incomm = 0;
    $tag = '';
    $comment = '';
    $lncomm = 0;
    $hadquotes = 0;
    $lnn = 0;
    prt("Processing $ccnt lines, from file [$fil]...(1)\n") if ($opts & 1);
    for ($k = 0; $k < $ccnt; $k++) {
        $cline = $clines[$k];
        $lnn++;
        $k2 = $k + 1;
        chomp $cline;
        $tline = $cline;    # trim_all($cline);
        $ll = length($tline);
        $tag = '';
        $fnd1 = 0;
        $intest = 0;
        if (($tline =~ /\s+main(\s|\()+/)||
            ($tline =~ /^main(\s|\()+/)){
            $fnd1 = 1;
            if (@ifstack) {
                $wd = $ifstack[-1];  # get LAST
                if ($wd =~ /TEST/i) {
                    $intest = 1;
                }
            }
        }
        if ( !$incomm && ($tline =~ /^\s*#\s*include\s+(.+)/)) {
            $inc = $1;
            $inc =~ s/\s+\/\/.*$//;
            $inc =~ s/\s+\/\*.*$//;
            push(@includes, $inc);
            next;    # skip '#include <main/main.h>' like INCLUDE lines
        }
        # FIX20110306 - Does NOT have to be a 'space', like '#if(WINVER >= 0x0400)'
        # if ($cline =~ /^\s*#\s*(if\w*)\s+(.+)/) {
        if ($cline =~ /^\s*#\s*(if\w*)\s*(.+)/) {
            push(@ifstack,"$1 $2");
            $tmpc = scalar @ifstack;
            push(@allifs, "$lnn:$tmpc: $1 $2 [$cline]"); # FIX20110306 - only for diagnostics
        } elsif ($cline =~ /^\s*#\s*endif/) {
            if (@ifstack) {
                $tmpc = scalar @ifstack;
                $tmp = pop @ifstack;  # FIX20110306 - keep popped, only for diagnostics
                push(@allifs, "$lnn:$tmpc: pop $tmp [$cline]"); # FIX20110306 - only for diagnostics
            } else {
                prtw( "WARNING:$fil:$lnn: line [$cline] ENDIF without stack!\n" );
                $tmpc = scalar @allifs;
                prt("Full list of $tmpc #if parsing...\n");
                foreach $tmp (@allifs) {
                    prt("$tmp\n"); # FIX20110306 - only for diagnostics
                }
            }
        }
        $comment .= "\n" if length($comment);
        $lncomm = 0;
        $ch = '';
        $hadquotes = 0;
        $minq = 0;
        for ($j = 0; $j < $ll; $j++) {
            $pch = $ch;
            $ch = substr($tline,$j,1);
            if ($incomm) {
                # only looking for CLOSE comment */
                $comment .= $ch;
                if (($ch eq '/') && ($pch eq '*')) {
                    $incomm = 0;
                }
            } else {
                if (($ch eq '"')||($ch eq "'")) {
                    # start of QUOTE
                    $qc = $ch;
                    $j++;    # to next char
                    $quoted = $ch;
                    $wd = '';
                    for ( ; $j < $ll; $j++) {
                        $pch = $ch;
                        $ch = substr($tline,$j,1);
                        $quoted .= $ch;
                        if (($ch eq $qc)&&($pch ne "\\")) {
                            last;    # out of here
                        }
                        $pch = $ch;
                        if ($ch =~ /\w/) {
                            $wd .= $ch;
                        } elsif (length($wd)) {
                            $minq = 1 if ($wd eq 'main');
                            $wd = '';
                        }
                    }
                    $hadquotes++;
                } elsif (($ch eq '*') && ($pch eq '/')) {
                    # comment start /* until */
                    $incomm = 1;
                    $wascomm = 1;
                    $comment = $pch.$ch;
                } elsif (($ch eq '/') && ($pch eq '/')) {
                    $j = $ll;    # skip rest of line
                    $lncomm = 1;
                } else {
                    if ($ch =~ /\w+/) { #if ($ch =~ /[main]/) {
                        $tag .= $ch;
                    } else {
                        # NOT alphanumeric
                        if ($tag eq 'main') {
                            #prt( "Found a main ...\n" );
                            #prt( "$tline\n" );
                            #push(@mains, $tline);
                            if ($intest) {
                                prtw("WARNING:$fil:$lnn: line[$cline] NOT counted, since in 'TEST' switch - BUT CHECK! (4)\n" ) if ($opts & 4);
                                $fndit++;
                            } else {
                                $fndm++;
                            }
                        }
                        $tag = '';
                    }
                }
            }
        }
        if ($fnd1 && !$fndm && !$lncomm && !$incomm && !$wascomm && !$intest) {
            if ($hadquotes) {
               if ($minq) {
                  prtw( "WARNING:$fil:$lnn: 'main' in quotes! CHECK no other! (8)\n" ) if ($opts & 8);
               } else {
                  prtw( "WARNING:$fil:$lnn: MISSED main! But maybe in QUOTES! CHECK! (8)\n" ) if ($opts & 8);
               }
            } else {
               prtw( "\nERROR:$fil:$lnn: MISSED main! WHY??? (8)\n" ) if ($opts & 8);
            }
            if ($opts & 2) {
               prtw( "WARNING: LINE[$tline] (2)\n" );
            } else {
               prt( "line=[".trim_all($tline)."] (16)\n" ) if ($opts & 16);
            }
        }
        $wascomm = $incomm;
        $pline = $cline;
    }

    # done all lines
    if (@ifstack) {
        $cline = "WARNING:$fil:$lnn: Still ".scalar @ifstack." items in IF stack!\n";
        foreach $pline (@ifstack) {
            $cline .= "$pline ";
        }
        prtw("$cline (32)\n") if ($opts & 32);
    }

    #return $fndm;
    $results{'LINE_COUNT'} = $ccnt;
    $results{'MAIN_COUNT'} = $fndm;
    $results{'MAIN_OTHER'} = $fndit;
    $results{'INCLUDES'} = \@includes;
    return \%results;
}

sub recursive_src_scan($$$);

sub recursive_src_scan($$$) {
    my ($fil,$opts,$rparams) = @_;
    my $rdh = ${$rparams}{'TMP_DONE_HASH'};
    return if (defined ${$rdh}{$fil});
    ${$rdh}{$fil} = 1;
    my $rh = src_scan($fil,$opts);
    ${$rparams}{'TMP_LINE_TOTAL'} += ${$rh}{'LINE_COUNT'};
    my $key = 'INCLUDES';
    if (defined ${$rh}{$key}) {
        my ($nam,$dir) = fileparse($fil);
        my $ra = ${$rh}{$key};
        my ($inc,$ff,$fcnt,@srcs);
        foreach $inc (@{$ra}) {
            $inc =~ s/^<(.+)>$/$1/;
            $inc =~ s/^"(.+)"$/$1/;
            $ff = $dir.$inc;
            @srcs = ();
            if (-f $ff) {
                push(@srcs,$ff);
            } else {
                if ($inc =~ /(\\|\/)/) {
                    my ($f2,$d2) = fileparse($inc);
                    $fcnt = ac_is_file_in_scan($rparams,$f2,$d2,\@srcs);
                } else {
                    $fcnt = ac_is_file_in_scan($rparams,$inc,$dir,\@srcs);
                }
            }
            foreach $ff (@srcs) {
                recursive_src_scan($ff,$opts,$rparams);
            }
        }
    }
}

sub full_src_scan_of_files($$$) {
    my ($rfils,$opts,$rparams) = @_;
    my %done = ();
    ${$rparams}{'TMP_DONE_HASH'} = \%done;
    ${$rparams}{'TMP_LINE_TOTAL'} = 0;
    my ($fil);
    foreach $fil (@{$rfils}) {
        recursive_src_scan($fil,$opts,$rparams);
    }
    return \%done;
}

1;
# eof - lib_srcscan.pl