#!/usr/bin/perl
    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
	if $running_under_some_shell;
#!/usr/bin/perl

use strict;

# information about tests read from .res files
# a hashs, key is the test name (res file name), value is:
#   a hash, the keys define a "perl like structure":
#       'RunCount'   ... integer, defines how many times the test was started
#       'TestCase'  ... a hash, key is the test case name, value is:
#           a hash: keys define a "perl like structure":
#	       'RunCount'    ...  integer
#              'EntryType'   ...  a hash, keys define a "perl like structure":
#                  'Error'       ...  a hash, keys define a "perl like structure":   
#	           'Warning'     ...  -------- // -------
#	           'Message'     ...  -------- // -------
#	           'Assertion'   ...  -------- // -------
#                  'QAError'     ...  -------- // -------
#	           'AssertStack' ...  -------- // -------
#	           'CallStack'   ...  -------- // -------
#	               'Count'    ... integer
#		       'EntryByID'  ...  a hash, the key is the entryId, value is
#		           array of entry messages
my %resData1 = ();
my %resData2 = ();

# User selected sorting order is configured via the following two global
#variables:
my $sortStatNumDown = 1;		# numeric sorting order
my @sortStatColumnsRequest = ();	# might be used to redefine default sorting to do it by another columns

# this global pointer is used to pass the selected sortStatColumns table to
# the function SortStat
my $sortStatColumnsp = 0;

# list of all entries
# it is used to translate integer to string
my @EntryTypeName = 
(
	"TestScript",
	"TestCase",
	"Error",
	"CallStack",
	"Message",
	"Warning",
	"Assertion",
	"QAError",
	"AssertStack"
);

# list of entries that can be part of a test case
my @TestCaseEntries =
(
	"Error",
	"CallStack",
	"Message",
	"Warning",
	"Assertion",
	"QAError",
	"AssertStack"
);

# list of entries that are part of a test case and are important for
# the Total counts statistic
my @SummaryTestCaseEntries =
(
	"Error",
	"Warning",
	"QAError"
);


# FIXME, could this be automatized?
my %knownIDs = (
	'20000'	 => 'could not be executed',
	'20008'  => 'server timeout while waiting for answer',
	'20009'  => 'application has been restarted',
	'20010'  => 'cannot be started',
	'20014'  => 'XXX errors occured',
	'20016'  => 'XXX warnings occured',
	'20023'  => 'XXX warnings occured during initialization',
	'20018'  => 'Slot/Control unknown',
	'22009'  => 'Pop-up menu not open',
	'22014'	 => 'unknown method',
	'22015'  => 'Invalid Parameters',
	'22018'  => 'could not be found',
	'22019'  => 'is not visible',
	'22020'  => 'could not be accessed',
	'22021'  => 'entry member XX is too large at Select. Max allowd is YY',
	'22022'  => 'entry member XX is too small at Select. Min allowd is YY',
	'22030'  => 'tab page not found at SetPage',
	'22035'  => 'entry at select not found',
	'22038'  => 'The button is disabled in ToolBox at Click',
	'22041'  => 'TearOff failed in ToolBot at TeadOff',
	'22048'  => 'There is no Cancel button at Cancel',
	'22049'  => 'There is no Yes button at Yes',
	'22050'  => 'There is no No button at No',
	'22063'  => 'could not be run: Disabled'
	);

###################################################################
# subroutines that are used to load the data from .res files to
# an internal structure

sub AnalyzeResFile($$) {

    my ($resDatap, $resFile) = @_;
    
    open (RES_FILE, $resFile) || die "can't open $resFile for reading: $!\n";

    my $resFileName = $resFile;
    $resFileName =~ s/.*\///;
    $resFileName =~ s/.res$//;

#    printf "Analyzing $resFile ...\n";

    unless ($resDatap->{$resFileName}) {
	$resDatap->{$resFileName} = {};
	$resDatap->{$resFileName}{'RunCount'} = 0;
	$resDatap->{$resFileName}{'TestCase'} = {};
    }

    my $knownFileFormat = 0;
    my $testCase = 'unknown';

    while (my $line = <RES_FILE>) {
        chomp $line;
    
	if ($line =~ /^File Format Version: 3/) {
	    $knownFileFormat=1;
	    next;
	}
	
	if ($line =~ /^([0-9]);([^;]*);([^;]*);([^;]*);([^;]*);\s*\"([^\"]*)\"/) {
	    my $type = "$1";
	    my $message = "$6";
	
	    if ($type == 0) {
		# test runned
		++$resDatap->{$resFileName}{'RunCount'};
		$testCase = 'unknown';
	    } elsif ($type == 1) {
		# test case runned
		if ("$message" eq '%ResId=20002%') {
		    $testCase = "Reading_the_files";
		} elsif ("$message" eq '%ResId=21001%') {
		    $testCase = "Outside_of_testcase";
		} elsif ("$message" eq '') {
		    # ugly entry, we want to ingnore it at all
		    next;
		} else {
		    $testCase = $message;
		    $testCase =~ s/^([^\(]+)\(.*$/$1/;	# bin parameters
		}

		unless ($resDatap->{$resFileName}{'TestCase'}{$testCase}) {
		    $resDatap->{$resFileName}{'TestCase'}{$testCase} = {};

		    $resDatap->{$resFileName}{'TestCase'}{$testCase}{'RunCount'} = 0;
		    $resDatap->{$resFileName}{'TestCase'}{$testCase}{'EntryType'} = {};
		    for my $entryTypeName ( @TestCaseEntries ) {
			$resDatap->{$resFileName}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName} = {};
			$resDatap->{$resFileName}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'Count'} = 0;
			$resDatap->{$resFileName}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'} = {};
		    }
		}
		
		++$resDatap->{$resFileName}{'TestCase'}{$testCase}{'RunCount'};
#		print "TestCase: $testCase\n";
	    } elsif ( $type > 1  &&  $type <= 8 ) {
		# a message a part of a test case
		my $entryTypeName = $EntryTypeName[$type];

		# quess problem type
		my $entryID = "unknown";
#	    	print "$message\n";
		if ($message =~ /\%ResId=([0-9]*)/) {
		    $entryID = "$1";
		}
		
		# skip some special entries
		if ($type == 5) {
		    # skip warnings about number of warnings, erros, etc.
		    if ( $entryID == 20014 || 
		         $entryID == 20016 ||
			 $entryID == 20023 ) {
			next;
		    }
		}
		
		unless ($resDatap->{$resFileName}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID}) {
		    $resDatap->{$resFileName}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID} = [];
		}
		push @{ $resDatap->{$resFileName}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID} }, $message;

		++$resDatap->{$resFileName}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'Count'};
	    } else {
		die "Error: $resFile:$.: unknown entry\n";
	    }
	} else {
	    die "Error: $resFile:$.: broken file format\n";
	}
    }

    close (RES_FILE);

    ($knownFileFormat) || die "Error: $resFile: Unknown file format\n";
}

sub AnalyzeDir($$) {
    my ($resDatap, $resDir) = @_;
    my $resDirh;                                                                                                                              
    
    opendir($resDirh, $resDir) || die "Can't open $resDir: $!";
    while (my $resFile = readdir ($resDirh)) {
        $resFile =~ /^\./ && next;     # hidden
        $resFile =~ /\.res$/ || next;  # non-res
	
#        print "Analyzing $resDir/$resFile ...\n";
	AnalyzeResFile($resDatap, "$resDir/$resFile");
    }
    closedir($resDirh);
}

########################################################################
# The following subroutines counts/extracts a specific information
# that is necessary in more types of statistics

sub CountTestScripts($)
{
    my ($resDatap) = @_;
    my $count = 0;
    
    for my $testScript (keys %{$resDatap}) {
	$count += $resDatap->{$testScript}{'RunCount'};
    }
    
    return $count;
}

sub CountTestCases($)
{
    my ($resDatap, $resFile) = @_;
    my $count = 0;

    for my $testScript (keys %{$resDatap}) {
        for my $testCase (keys % {$resDatap->{$testScript}{'TestCase'}} ) {
	    $count += $resDatap->{$testScript}{'TestCase'}{$testCase}{'RunCount'};
	}
    }
    
    return $count;
}

sub CountEntriesForEntry($$) {
    my ($resDatap, $entryTypeName) = @_;
    
    unless (grep /^$entryTypeName$/i, @TestCaseEntries) {
	die "Internal error: Function StatEntryIDsForEntry called with wrong parameter.\n" .
	    "Should use of: @TestCaseEntries\n";
    }

    my $count = 0;

    for my $testScript (keys %{$resDatap}) {
        for my $testCase (keys % {$resDatap->{$testScript}{'TestCase'}} ) {
	    $count += $resDatap->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'Count'};
	}
    }
    
    return $count;
}

sub CountEntriesForEntryAndEntryID($$$)
{
    my ($resDatap, $entryTypeName, $entryID) = @_;
    my $count = 0;
    
    for my $testScript (keys %{$resDatap}) {
        for my $testCase (keys % {$resDatap->{$testScript}{'TestCase'}} ) {
	    if ($resDatap->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID}) {
		$count += scalar @ {$resDatap->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID}};
	    }
	}		
    }

    return $count;
}

sub CountEntriesForTestScriptAndEntry($$$)
{
    my ($resDatap, $testScript, $entryTypeName) = @_;
    
    my $count = 0;
    if ($resDatap->{$testScript}) {
        for my $testCase (keys % {$resDatap->{$testScript}{'TestCase'}} ) {
	    $count += $resDatap->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'Count'};
	}
    }
    return $count;
}

sub CountEntriesForTestScriptEntryAndEntryID($$$$)
{
    my ($resDatap, $testScript, $entryTypeName, $entryID) = @_;

    my $count = 0;
    if ($resDatap->{$testScript}) {
	for my $testCase (keys % {$resDatap->{$testScript}{'TestCase'}} ) {
    	    if ($resDatap->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID}) {
		$count += scalar @ {$resDatap->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID}};
	    }
	}
    }		
    return $count;
}

sub FindEntryIDsForEntry($$)
{
    my ($resDatap, $entryTypeName) = @_;
    
    my %entryIDs = ();
    for my $testScript (keys %{$resDatap}) {
        for my $testCase (keys % {$resDatap->{$testScript}{'TestCase'}} ) {
	    for my $entryID ( keys % {$resDatap->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}}) {
	        $entryIDs{$entryID} = 1;
	    }
	}
    }
    return keys %entryIDs;
}

########################################################################
# The following subroutines fill the tables with particular statistics
# about test results

sub ListAll($$)
{
    my ($resDatap, $datap) = @_;

    push @{$datap}, ["TestScript", CountTestScripts($resDatap)];
    push @{$datap}, ["TestCase",   CountTestCases($resDatap)];
    foreach my $entry (@SummaryTestCaseEntries) {
	push @{$datap}, [$entry, CountEntriesForEntry($resDatap, $entry)];
    }
}

sub ListTestScripts($$)
{
    my ($resDatap, $datap) = @_;

    for my $testScript (keys %{$resDatap}) {
	push @{$datap}, [$testScript];
    }
}

sub ListTestScriptsScriptsForEntry($$$)
{    
    my ($resDatap, $entryTypeName, $datap) = @_;

    for my $testScript (keys %{$resDatap}) {
	my $count = CountEntriesForTestScriptAndEntry($resDatap, $testScript, $entryTypeName);
	if ($count) {
	    push @{$datap}, [$testScript, $count];
	}
    }
}

sub ListTestScriptsForEntryAndEntryID($$$$)
{
    my ($resDatap, $entryTypeName, $entryID, $datap) = @_;

    for my $testScript (keys %{$resDatap}) {
        my $count = CountEntriesForTestScriptEntryAndEntryID($resDatap, $testScript, $entryTypeName, $entryID);
        if ($count) {
	    push @{$datap}, [$testScript, $count];
	}
    }
}    

sub ListTestCases($$)
{
    my ($resDatap, $datap) = @_;

    for my $testScript (keys %{$resDatap}) {
	for my $testCase (keys % {$resDatap->{$testScript}{'TestCase'}} ) {
	    push @{$datap}, [$testScript,$testCase];
	}
    }
}

sub ListTestCasesforEntry($$$)
{
    my ($resDatap, $entryTypeName, $datap) = @_;

    for my $testScript (keys %{$resDatap}) {
	for my $testCase (keys % {$resDatap->{$testScript}{'TestCase'}} ) {
	    for my $entryID (keys % {$resDatap->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}} ) {
		my $entryIDCount = scalar @ {$resDatap->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID}};
		push @{$datap}, [$testScript, $testCase, $entryID, $entryIDCount];
	    }
	}
    }
}

sub ListEntryIDsForEntry($$$)
{
    my ($resDatap, $entryTypeName, $datap) = @_;

    for my $entryID (FindEntryIDsForEntry($resDatap, $entryTypeName)) {
	my $count = CountEntriesForEntryAndEntryID($resDatap, $entryTypeName, $entryID);
	my $idNote = $knownIDs{$entryID} ? $knownIDs{$entryID} : "";
	push @{$datap}, [$entryID, $count, $idNote];
    }
}

########################################################################
# The following subroutines fill the tables with particular statistics
# about comparsion (diff) of two test results
#
# All of them (except ListDiffAll) return only positive values. Then they
# are called twice with switched resData structures. This way we can get
# information also about removed test scripts/test cases/entries.

sub ListDiffAll($$$)
{
    my ($resDatap1, $resDatap2, $datap) = @_;

    push @{$datap}, ["TestScript", CountTestScripts($resDatap2) - CountTestScripts($resDatap1)];
    push @{$datap}, ["TestCase",   CountTestCases($resDatap2) - CountTestCases($resDatap1)];
    foreach my $entry (@SummaryTestCaseEntries) {
	push @{$datap}, [$entry, CountEntriesForEntry($resDatap2, $entry) - CountEntriesForEntry($resDatap1, $entry)];
    }
}

sub ListNewTestScripts($$$$)
{
    # $comment is used to modify the output in case we do the inverted search
    # for removed entries
    my ($resDatap1, $resDatap2, $comment, $datap) = @_;

    for my $testScript (keys %{$resDatap2}) {
	unless ($resDatap1->{$testScript}) {
	    push @{$datap}, [$testScript, $comment];
	}
    }
}

sub ListNewTestScriptsWithEntry($$$$$$)
{
    # $sign, $commentp are used to modify the output in case we do inverted
    # search for removed entries
    my ($resDatap1, $resDatap2, $entryTypeName, $sign, $commentp, $datap) = @_;

    for my $testScript (keys %{$resDatap2}) {
	my $count1 = CountEntriesForTestScriptAndEntry($resDatap1, $testScript, $entryTypeName);
	my $count2 = CountEntriesForTestScriptAndEntry($resDatap2, $testScript, $entryTypeName);
	my $countDiff = $count2 - $count1;
	if ($countDiff > 0) {
	    # old entry status:
	    #	0 = test script not found in old res files
	    #	1 = number of entries increased
	    my $oldTestStatus = 0;
	    if ($resDatap1->{$testScript}) {
		$oldTestStatus = 1;
	    }
	
	    push @{$datap}, [$testScript, $sign * $countDiff, $commentp->[$oldTestStatus]];
	}
    }
}

sub ListNewTestScriptsForEntryAndEntryID($$$$$$$)
{
    # $sign, $commentp are used to modify the output in case we do inverted
    # search for removed entries
    my ($resDatap1, $resDatap2, $entryTypeName, $entryID, $sign, $commentp, $datap) = @_;

    for my $testScript (keys %{$resDatap2}) {
        my $count1 = CountEntriesForTestScriptEntryAndEntryID($resDatap1, $testScript, $entryTypeName, $entryID);
        my $count2 = CountEntriesForTestScriptEntryAndEntryID($resDatap2, $testScript, $entryTypeName, $entryID);
	my $countDiff = $count2 - $count1;
	if ($countDiff > 0) {
	    # old entry status:
	    #   0 = test script not found in old res files
	    #   1 = test script found in old res files
	    my $oldTestStatus = 0;
    	    if ($resDatap1->{$testScript}) {
		$oldTestStatus = 1;
	    }
	    push @{$datap}, [$testScript, $sign * $countDiff, $commentp->[$oldTestStatus]];
	}
    }
}

sub ListNewTestCases($$$$)
{
    # $commentp is used to modify the output in case we do inverted search for
    # removed entries
    my ($resDatap1, $resDatap2, $commentp, $datap) = @_;

    for my $testScript (keys %{$resDatap2}) {
	for my $testCase (keys % {$resDatap2->{$testScript}{'TestCase'}} ) {
	    # old entry status:
	    #   0 = test script not found in old res files
	    #   1 = test script found in old res files
	    my $oldTestStatus = 0;
	    my $testCaseFound = 0;
    	    if ($resDatap1->{$testScript}) {
    		$oldTestStatus = 1;
		# we must not acess 
		if ($resDatap1->{$testScript}{'TestCase'}{$testCase}) {
		    $testCaseFound = 1;
		}
	    }
	    unless ($testCaseFound) {
		push @{$datap}, [$testScript,$testCase, $commentp->[$oldTestStatus]];
	    }
	}
    }
}

sub ListNewEntry($$$$$$)
{
    # $sign, $commentp are used to modify the output in case we do inverted
    # search for removed entries
    my ($resDatap1, $resDatap2, $entryTypeName, $sign, $commentp, $datap) = @_;
    
    for my $testScript (keys %{$resDatap2}) {
	for my $testCase (keys % {$resDatap2->{$testScript}{'TestCase'}} ) {
#	    print "Error: $testScript:$testCase:\n";
	    for my $entryID (keys % {$resDatap2->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}} ) {
		my $entryIDCountDiff = scalar @ {$resDatap2->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID}};
		# old entry status:
		#	0 = test script not found in old res files
		#       1 = test case not started in old res files
		# 	2 = entryID not found in old res files
		#	3 = number of entries increased
		my $oldTestStatus = 0;
		if ($resDatap1->{$testScript}) {
		    $oldTestStatus = 1;
		    if ($resDatap1->{$testScript}{'TestCase'}{$testCase}) {
		        $oldTestStatus = 2;
			if ($resDatap1->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID}) {
			    $oldTestStatus = 3;
			    $entryIDCountDiff -= scalar @ {$resDatap1->{$testScript}{'TestCase'}{$testCase}{'EntryType'}{$entryTypeName}{'EntryByID'}{$entryID}};
			}
		    }
		}
		if ($entryIDCountDiff > 0) {
		    push @{$datap}, [$testScript,$testCase,$entryID,$sign * $entryIDCountDiff,$commentp->[$oldTestStatus]];
		}
	    }
	}
    }	
}

sub ListNewEntryIDsForEntry($$$$$$)
{
    # $sign, $commentp are used to modify the output in case we do inverted
    # search for removed entries
    my ($resDatap1, $resDatap2, $entryTypeName, $sign, $commentp, $datap) = @_;

    for my $entryID (FindEntryIDsForEntry($resDatap2, $entryTypeName)) {
	my $count1 = CountEntriesForEntryAndEntryID($resDatap1, $entryTypeName, $entryID);
	my $count2 = CountEntriesForEntryAndEntryID($resDatap2, $entryTypeName, $entryID);
	my $countDiff = $count2 - $count1;
	if ($countDiff > 0) {
	    # old entry status:
	    #   0 = entry id not found in old res files
	    #   1 = entry id found in old res files
	    my $oldTestStatus = 0;
	    if ($count1) {
		$oldTestStatus = 1;
	    }
	    my $idNote = $knownIDs{$entryID} ? $knownIDs{$entryID} : "";
	    push @{$datap}, [$entryID, $sign * $countDiff, $commentp->[$oldTestStatus], $idNote];
	}
    }
}

###########################################################################
# universal subroutines that are used to print the various tables

sub SortStat
{
    my $sortStatColumnsCur = 0;
    my $sortStatColumnsMax = scalar @ {$sortStatColumnsp};
    my $i = 0;
    my $result = 0;
    
    while (!$result && $sortStatColumnsCur < $sortStatColumnsMax) {
        $i = $sortStatColumnsp->[$sortStatColumnsCur++];
        if ($sortStatNumDown) {
    	    $result = $b->[$i] <=> $a->[$i];
	} else {
	    $result = $a->[$i] <=> $b->[$i];
	}
	unless ($result) {
	    $result = $a->[$i] cmp $b->[$i];
	}
    }
    return $result;
}

sub SelectSorting($$)
{
    my ($datap, $sortStatColumnsDefaultp) = @_;
    
    if (scalar @sortStatColumnsRequest) {
	# filtered list of columns; it does not include column indexes that
	# are not supported by the current datap
	my @sortStatColumnsRequestValid = ();
	# at least one row has to be available to detect the count of columns
	my $columnsCount = 0; 
	if ($datap->[0]) {
	    $columnsCount = scalar @ {$datap->[0]};
	}
	foreach my $column (@sortStatColumnsRequest) {
	    if ($column >= 0 && $column < $columnsCount) {
		push @sortStatColumnsRequestValid, $column;
	    }
	}
	return \@sortStatColumnsRequestValid
    } else {
	# the sort order is not selected by the user, so the default one will
	# be used and it needs not be filtered
	return $sortStatColumnsDefaultp
    }
}

sub PrintStat($$$$$$$)
{
    my ($titleFmt, $headFmt, $dataFmt, $titlep, $headp, $datap, $sortDefp) = @_;
    
    printf "$titleFmt\n", @{$titlep};
    printf "------------------------------------------------------------------------------\n";
    printf "$headFmt\n", @{$headp};
    printf  "------------------------------------------------------------------------------\n";

    $sortStatColumnsp = SelectSorting($datap, $sortDefp);

    for my $linep ( sort SortStat @{$datap}) {
	printf "$dataFmt\n", @{$linep};
    }
}

##############################################################################
# the following subroutines collect data for the particural statisctics,
# defines how the output should look like and print the data

sub StatAll($)
{
    my ($resDatap) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-15.14s%-6s";
    my $dataFmt  = "%-15.14s%6d";
    
    my @title = "All tests summary:";
    my @head  =  ("Item", "Count");
    my @data  = ();

    my @sortDef = ();

    ListAll($resDatap, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub StatTestScripts($)
{
    my ($resDatap) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-20.19s";
    my $dataFmt  = "%-20.19s";
    
    my @title = "List of the started test scripts:";
    my @head  =  ("Test Script");
    my @data  = ();

    my @sortDef = (0);

    ListTestScripts($resDatap, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub StatTestScriptsForEntry($$)
{
    my ($resDatap, $entryTypeName) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-20.19s%-6s";
    my $dataFmt  = "%-20.19s%6d";
    
    my @title = "List of the started test scripts with $entryTypeName, counts $entryTypeName:";
    my @head  = ("Test Script", "Count");
    my @data  = ();

    my @sortDef = (1);

    ListTestScriptsScriptsForEntry($resDatap, $entryTypeName, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub StatTestScriptsForEntryAndEntryID($$$)
{
    my ($resDatap, $entryTypeName, $entryID) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-20.19s%-6s";
    my $dataFmt  = "%-20.19s%6d";
    
    my @title = "List of test cases with $entryTypeName, id $entryID, counts this $entryTypeName:";
    my @head  = ("Test Script", "Count");
    my @data  = ();

    my @sortDef = (1);

    ListTestScriptsForEntryAndEntryID($resDatap, $entryTypeName, $entryID, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub StatTestCases($)
{
    my ($resDatap) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-20.19s%-26.25s";
    my $dataFmt  = "%-20.19s%-26.25s";
    
    my @title = "List of the started test cases";
    my @head  =  ("Test Script", "Test Case");
    my @data  = ();

    my @sortDef = (0,1);

    my @newTestCases = ListTestCases($resDatap, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub StatTestCasesForEntry($$) {
    my ($resDatap, $entryTypeName) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-20.19s%-26.25s%-10.9s%-6s";
    my $dataFmt  = "%-20.19s%-26.25s%-10.9s%6d";
    
    my @title = "List of test cases with $entryTypeName, counts $entryTypeName:";
    my @head  = ("Test Script", "Test Case", "Entry ID", "Count");
    my @data  = ();

    my @sortDef = (3,0,1,2);

    my @newTestCases = ListTestCasesforEntry($resDatap, $entryTypeName, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub StatEntryIDsForEntry($$)
{
    my ($resDatap, $entryTypeName) = @_;


    my $titleFmt = "%s";
    my $headFmt  = "%-10.9s%-6s    %.60s";
    my $dataFmt  = "%-10.9s%6d    %.60s";
    
    my @title = "List of $entryTypeName entry IDs:";
    my @head  = ("Entry ID", "Count", "Entry ID explanation");
    my @data  = ();

    my @sortDef = (1);

    ListEntryIDsForEntry($resDatap, $entryTypeName, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

############################
# (diff)

sub DiffAll($$)
{
    my ($resDatap1, $resDatap2) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-15.14s%-6s";
    my $dataFmt  = "%-15.14s%+6d";
    
    my @title = "All tests summary (diff):";
    my @head  = ("Item", "Count");
    my @data  = ();

    my @sortDef = ();

    ListDiffAll($resDatap1, $resDatap2, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub DiffTestScripts($$)
{
    my ($resDatap1, $resDatap2) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-20.19s%-10.9s";
    my $dataFmt  = "%-20.19s%-10.9s";
    
    my @title = "List of the started test scripts (diff):";
    my @head  = ("Test Script", "Comment");
    my @data  = ();

    my @sortDef = (0);

    ListNewTestScripts($resDatap1, $resDatap2, "only new", \@data);
    ListNewTestScripts($resDatap2, $resDatap1, "only old", \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub DiffTestScriptsForEntry($$$)
{
    my ($resDatap1, $resDatap2, $entryTypeName) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-20.19s%-6s %-15.14s";
    my $dataFmt  = "%-20.19s%+6d %-15.14s";
    
    my @title = "List of the started test scripts with $entryTypeName, counts $entryTypeName (diff):";
    my @head  = ("Test Script", "Count", "Comment");
    my @data  = ();

    my @sortDef = (1,0);

    my @newComment = ( 
	"only new",
	"count changed"
    );

    my @oldComment = (
	"only old",
	"count changed"
    );

    ListNewTestScriptsWithEntry($resDatap1, $resDatap2, $entryTypeName, +1, \@newComment, \@data);
    ListNewTestScriptsWithEntry($resDatap2, $resDatap1, $entryTypeName, -1, \@oldComment, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub DiffTestScriptsForEntryAndEntryID($$$$)
{
    my ($resDatap1, $resDatap2, $entryTypeName, $entryID) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-20.19s%-6s%-15.14s";
    my $dataFmt  = "%-20.19s%-6d%-15.14s";
    
    my @title = "List of test cases with $entryTypeName, id $entryID, counts this $entryTypeName (diff):";
    my @head  = ("Test Script", "Count", "Comment");
    my @data  = ();

    my @sortDef = (1,0);

    my @newComment = ( 
	"new test",
	"count changed"
    );

    my @oldComment = (
	"skip test",
	"count changed"
    );

    ListNewTestScriptsForEntryAndEntryID($resDatap1, $resDatap2, $entryTypeName, $entryID, +1, \@newComment, \@data);
    ListNewTestScriptsForEntryAndEntryID($resDatap2, $resDatap1, $entryTypeName, $entryID, -1, \@oldComment, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub DiffTestCases($$)
{
    my ($resDatap1, $resDatap2) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-20.19s%-26.25s%-16.15s";
    my $dataFmt  = "%-20.19s%-26.25s%-16.15s";
    
    my @title = "List of the started test cases (diff):";
    my @head  =  ("Test Script", "Test Case", "Comment");
    my @data  = ();

    my @sortDef = (2,0,1);

    my @newComment = ( 
	"only new t.scr.",
	"only new t.case"
    );

    my @oldComment = (
        "only old t.scr.",
        "only old t.case",
    );

    ListNewTestCases($resDatap1, $resDatap2, \@newComment, \@data);
    ListNewTestCases($resDatap2, $resDatap1, \@oldComment, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub DiffTestCasesForEntry($$$)
{
    my ($resDatap1, $resDatap2, $entryTypeName) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-20.19s%-26.25s%-10.9s%-6s   %.40s";
    my $dataFmt  = "%-20.19s%-26.25s%-10.9s%+6d   %.40s";
    
    my @title = "List of test cases with $entryTypeName, counts $entryTypeName (difference):";
    my @head  =  ("Test Script", "Test Case", "Entry ID", "Count", "Comment");
    my @data  = ();

    my @sortDef = (3,0,1);

    my @newComment = ( 
	"only new t.scr.",
	"only new t.case",
	"ID only in new",
	"count changed"
    );

    my @oldComment = ( 
        "only old t.scr.",
        "only old t.case",
        "ID just in old",
        "count changed"
    );

    ListNewEntry($resDatap1, $resDatap2, $entryTypeName, +1, \@newComment, \@data);
    ListNewEntry($resDatap2, $resDatap1, $entryTypeName, -1, \@oldComment, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

sub DiffEntryIDsForEntry($$$)
{
    my ($resDatap1, $resDatap2, $entryTypeName) = @_;

    my $titleFmt = "%s";
    my $headFmt  = "%-10.9s%-6s    %-15.14s%.40s";
    my $dataFmt  = "%-10.9s%+6d    %-15.14s%.40s";
    
    my @title = "List of $entryTypeName entry IDs (diff):";
    my @head  = ("Entry ID", "Count", "Comment", "Entry ID explanation");
    my @data  = ();

    my @sortDef = (1,0);

    my @newComment = ( 
	"only in new",
	"count changed"
    );

    my @oldComment = (
	"only in old",
	"count changed"
    );

    ListNewEntryIDsForEntry($resDatap1, $resDatap2, $entryTypeName, +1, \@newComment, \@data);
    ListNewEntryIDsForEntry($resDatap2, $resDatap1, $entryTypeName, -1, \@oldComment, \@data);

    PrintStat($titleFmt, $headFmt, $dataFmt, \@title, \@head, \@data, \@sortDef);
}

########################################################################
# help

sub Usage()
{
    print "This tool prints statistic from .res files genereated by qatesttool\n\n" .
    
          "Usage:\n".
	  "\ttest-ooo-analyze [--help] [--diff] [stat-type-sw] [--entry=<entry>]\n" .
	  "\t[--entry-id=<id>] [--sort=[column[,column]...] [--revert] res...\n\n" .
	
	  "Options:\n" .
	  "\t--help: prints this help\n\n" .

	  "\t--diff: compares statistic of two test tool results. Exactly two .res\n" .
	  "\t\tfiles or exactly two directories has to be defined by the res...\n".
	  "\t\tparameter\n\n" .
	  
	  "\tstat-type-sw: defines statistic type, see below\n\n" .
	  
	  "\t--entry=<entry>: almost all statistics gives more detailed output if a\n" .
	  "\t\tparticular entry is defined. The possible values are: Error,\n" .
	  "\t\tWarning, QAError, Message, CallStack, Assertion, AssertStack.\n\n". 
	  
	  "\t--entry-id=<id>: filters the statistic output to count only entries\n" .
	  "\t\twith given id. It must be used together with --entry=<entry>.\n" .
	  "\t\tIt actually works only with --stat-test-case.\n\n" .
	  
	  "\t--sort=[column[,column]...: redefines the default sorting; the value\n" .
	  "\t\tis a comma separated list of column numbers, For example, the \n" .
	  "\t\toutput is sorted by the 1st and 2nd column with --sort=1,2.\n" .
	  "\t--reverse: reverse the sort order of numeric values\n\n" .
	  
	  "\tres... :    list of res files or directories with res files\n" .
	  "\tres1, res2: two res files or direcotries to be compared\n\n" .
	  
	  "Types of statistic:\n".
	  "\t--stat-all:         statistic of total numbers (default one)\n" .
	  "\t--stat-test-script: statictic by test scripts\n" .
	  "\t--stat-test-case:   statictic by test cases\n" .
	  "\t--stat-entry-id:    statictic by the given entry IDs\n";
}


#######################################################################
#######################################################################
# MAIN
#######################################################################
#######################################################################

my $op = 'stat';
my $stat_type = "all";
my $entry = '';
my $entryID = '';
my @resPaths = ();

foreach my $a (@ARGV) {
    if ($a eq '--diff' ||
	$a eq '--help') {
	$op = $a;
	$op =~ s/^\-\-//;
    } elsif ($a eq '--stat-all' ||
	     $a eq '--stat-test-script' ||
	     $a eq '--stat-test-case' ||
	     $a eq '--stat-entry-id') {
	$stat_type = $a;
	$stat_type =~ s/^\-\-stat\-//;
    } elsif ($a =~ m/--entry=(.*)/) {
	$entry = $1;
	unless (grep /^$entry$/i, @TestCaseEntries) {
	    my $tmp = join "\n\t\t", @TestCaseEntries;
	    die "Error: unknown entry: \"$entry\". Possible values are:\n" .
	        "\t\t$tmp\n";
	}
    } elsif ($a =~ m/--entry-id=(.*)/) {
	$entryID = $1;
    } elsif ($a =~ m/--sort=([0-9,]*)/) {
	@sortStatColumnsRequest = split(",", $1);
	# let the user count the columns from 1
	for my $i (0 .. scalar @sortStatColumnsRequest) {
	    --$sortStatColumnsRequest[$i];
	}
    } elsif ($a =~ m/--reverse/) {
	$sortStatNumDown = 0;
    } elsif (-f $a || 
	     -d $a) {
	push @resPaths, $a;
    } else {
	die "Error: Unknown parameter \"$a\", try --help.\n";
    }
}

#print "op = $op\n";
#print "stat_type = $stat_type\n";
#print "entry = $entry\n";
#print "resPaths = @resPaths\n";

# FIXME: Is there a nicer solution for this huge if/elsif/else game,
#        so that the following check can be on a more appropriate place?
if ($entryID && $stat_type ne 'test-script') {
    die "Error: --entry-id is currently supported only with --stat-test-script\n";
}

if ($op eq 'help') {

    Usage();

} elsif ($op eq 'stat') {

    # pure statisctics

    (scalar @resPaths) || die "Error: No res path defined, try --help\n";
    
    # load .res files
    for my $path (@resPaths) {
	if (-f $path) {
	    AnalyzeResFile(\%resData1, $path);
	} elsif (-d $path) {
	    AnalyzeDir(\%resData1, $path);
	} else {
	    die "Error: \"$path\" is neither directory nor file\n";
	}
    }

    # do the selected statistic
    if ($entry) {
    	if ($stat_type eq 'all') {
	    die "Sorry, this statistic does not exist. Try without the option --entry.\n";
	} elsif ($stat_type eq 'test-script') {
	    if ($entryID) {
	        StatTestScriptsForEntryAndEntryID(\%resData1, $entry, $entryID);
	    } else {	
		StatTestScriptsForEntry(\%resData1, $entry);
	    }
	} elsif ($stat_type eq 'test-case') {
	    StatTestCasesForEntry(\%resData1, $entry);
	} elsif ($stat_type eq 'entry-id') {
	    StatEntryIDsForEntry(\%resData1, $entry);
	} else {
	    die "Internal error: unknown statisitc type: $stat_type\n";
	}
    } else {
    	if ($stat_type eq 'all') {
	    StatAll(\%resData1);
	} elsif ($stat_type eq 'test-script') {
	    StatTestScripts(\%resData1);
	} elsif ($stat_type eq 'test-case') {
	    StatTestCases(\%resData1);
	} elsif ($stat_type eq 'entry-id') {
	    die "Error: Sorry, this statistic has not be implmented yet\n" .
		"       Try with the --entry option\n";
	} else {
	    die "Internal error: unknown statisitc type: $stat_type\n";
	}
    }    

} elsif ($op = 'diff') {

    # diff of two statisctics

    (scalar @resPaths == 2) || die "Error: Wrong number of paths. You must define exactly two files or\n" .
                                    "       directories as the res1, res2 parameters.\n";
    
    # load .res files
    if (-f $resPaths[0] && -f $resPaths[1] ) {
	    AnalyzeResFile(\%resData1, $resPaths[0]);
	    AnalyzeResFile(\%resData2, $resPaths[0]);
    } elsif (-d $resPaths[0] && -d $resPaths[0]) {
	    AnalyzeDir(\%resData1, $resPaths[0]);
	    AnalyzeDir(\%resData2, $resPaths[1]);
    } else {
	die "Error: Wrong type of paths. This operation works only if you define exactly two files or two\n" .
	    "       or two direcotries as the res1, res2 parameters.\n";
    }


    # do the selected statistic
    if ($entry) {
    	if ($stat_type eq 'all') {
	    die "Sorry, this statistic does not exist. Try without the option --entry.\n";
	} elsif ($stat_type eq 'test-script') {
	    if ($entryID) {
	        DiffTestScriptsForEntryAndEntryID(\%resData1, \%resData2, $entry, $entryID);
	    } else {	
		DiffTestScriptsForEntry(\%resData1, \%resData2, $entry);
	    }
	} elsif ($stat_type eq 'test-case') {
	    DiffTestCasesForEntry(\%resData1, \%resData2, $entry);
	} elsif ($stat_type eq 'entry-id') {
	    DiffEntryIDsForEntry(\%resData1, \%resData2, $entry);
	} else {
	    die "Internal error: unknown statistic type: $stat_type\n";
	}
    } else {
    	if ($stat_type eq 'all') {
	    DiffAll(\%resData1, \%resData2);
	} elsif ($stat_type eq 'test-script') {
	    DiffTestScripts(\%resData1, \%resData2);
	} elsif ($stat_type eq 'test-case') {
	    DiffTestCases(\%resData1, \%resData2);
	} elsif ($stat_type eq 'entry-id') {
	    die "Error: Sorry, this statistic has not be implmented yet\n" .
		"       Try with the --entry option\n";
	} else {
	    die "Internal error: unknown statistic type: $stat_type\n";
	}
    }    

} else {
    
    die "Internal error: unknown operation: $op\n";

}
