#!/perl -w
# NAME: getwarnlist.pl
# AIM: VERY SPECIFIC - read getwarnlist.txt, the output of MSVC compile,
# and give a warning list, by project
# 9/13/2009 - 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);

my $in_file = 'getwarnlist.txt';
my $wn_key = '-NUMBER_HASH-';

prt( "$0 ... in file [$in_file]...\n" );

sub process_warn_file($) {
    my ($fil) = shift;
    my @warns = ();
    my (@lines,$lncnt,$line,$lnnum,$wnum,$proj,$conf,$clnn);
    my ($key);
    my %hash = ();
    my %warn_num = ();
    if (!open INF, "<$fil") {
        prt("ERROR: Unable to open [$fil]...\n");
        return \%hash;
    }
    @lines = <INF>;
    close INF;
    $lncnt = scalar @lines;
    prt( "Processing $lncnt lines...\n" );
    # look for lines of the form
    # c:\projects\hb\x264\common\osdep.h(177) : warning C4293: '>>' : shift count negative or too big, undefined behavior
    $clnn = 0;
    foreach $line (@lines) {
        $clnn++;
        chomp $line;
        if ($line =~ /^.+\((\d+)\)\s+:\s+warning\s+C(\d+):.+$/) {
            $lnnum = $1;
            $wnum = $2;
            #prt( "$lnnum: - warning C".$wnum."\n" );
            push(@warns, [$wnum, $lnnum]);
            if (defined $warn_num{$wnum}) {
                $warn_num{$wnum} .= "|$lnnum";
            } else {
                $warn_num{$wnum} = "$lnnum";
            }
        } elsif ($line =~ /------\s+Build\s+started:\s+Project:\s+(.+),\s+Configuration:\s+(.+)\s+-----/) { # ------ Build started: Project: libx264, Configuration: Debug Win32 ------
            if (@warns) {
                $hash{$key} = [@warns];
            } elsif (length($key)) {
                $hash{$key} = [@warns];
            }

            $proj = $1;
            $conf = $2;
            prt( "proj=[$proj], conf=[$conf]\n" );
            $key = "$proj - $conf";
            @warns = ();
        }
    }
    if ((@warns)||(length($key))) {
        $hash{$key} = [@warns];
    }
    $key = $wn_key;
    $hash{$key} = \%warn_num;
    return \%hash;
}

sub show_hash_ref($) {
    my ($hr) = @_;
    my ($k,$v,$c,$k2,$m,$min,$len,$i,$pcnt,$wcnt);
    my %pwl = ();
    $m = '';
    foreach $k (keys %{$hr}) {
        $v = ${$hr}{$k};
        if ($k eq $wn_key) {
            $c = scalar keys(%{$v});
            prt( "Got $c warning types...\n" );
            $m = '';
            foreach $k2 (keys %{$v}) {
                $m .= ';' if (length($m));
                $m .= "$k2";
            }
            prt("Warning List [$m]\n") if ($c);
        } else {
            # prt("$k\n");
        }
    }
    $pcnt = 0;
    foreach $k (keys %{$hr}) {
        $v = ${$hr}{$k};
        if ($k eq $wn_key) {
            # done this
        } else {
            $pcnt++;    # another project/configuration
            $c = scalar @{$v};
            my %w = ();
            for ($i = 0; $i < $c; $i++) {
                $k2 = ${$v}[$i][0];
                if (defined $w{$k2}) {
                    $w{$k2}++;
                } else {
                    $w{$k2} = 1;
                }
            }
            $m = '';
            foreach $k2 (keys %w) {
                $m .= ';' if (length($m));
                $m .= "$k2";
            }

            prt("$k  - $c warnings [$m]\n");
            if (defined $pwl{$m}) {
                $pwl{$m}++;
            } else {
                $pwl{$m} = 1;
            }
        }
    }
    $wcnt = scalar keys(%pwl);
    if (($pcnt > 1)&&($wcnt == 1)) {
        prt( "The warning list is the SAME for $pcnt projects - configurations ie [$m]\n" );
    }
}

my $hash_ref = process_warn_file($in_file);
show_hash_ref($hash_ref);

close_log($outfile,0);
exit(0);

# eof - getwarnlist.pl
