#!/usr/bin/perl -w

use strict;
use warnings;

use Test::Repocop::Options;
use Test::Repocop::TestDB;
use Test::Repocop::Metadata;
use Test::Repocop::ACLWrapper;
use Data::Array2ArrayMap::Hash::XSTree;
use File::Path;
use File::Basename;
use HTML::Template::Pro;

my ($by_srpm,$by_leader,$by_packager,$by_test,$by_acl)=(1,1,0,1,1);
&Test::Repocop::Options::get_common_options(
	    "by-acl!"  => \$by_acl,
	    "by-leader!"  => \$by_leader,
	    "by-packager!"  => \$by_packager,
	    "by-srpm!"  => \$by_srpm,
	    "by-test!"  => \$by_test,
);
&Test::Repocop::Options::die_if_nothing_to_report();

my $repocop_reportdir="$repocop_cachedir/reports/html";
my $img_dir='img/';

print "creating reports in $repocop_reportdir...\n" if $verbose;

my $TEST2RPM=Data::Array2ArrayMap::Hash::XSTree->new();
my $RPM2TEST=Data::Array2ArrayMap::Hash::XSTree->new();
my $SRPM2RPM=Data::Array2ArrayMap::Hash::XSTree->new();
my $ACL2TEST=Data::Array2ArrayMap::Hash::XSTree->new();
my $PACKAGER2TEST=Data::Array2ArrayMap::Hash::XSTree->new();
my $LEADER2TEST=Data::Array2ArrayMap::Hash::XSTree->new();
my %TEST;

my $aclmap=Test::Repocop::ACLWrapper->new();
my $metadata=Test::Repocop::Metadata->new();
my $testdb=Test::Repocop::TestDB->new();
my $cache=$testdb->get_pkg_test_status_result_iterator();
while (my ($rpm,$test,$status,$result)=$cache->iterate4_filtered()) {
    # html-linearize
    chomp $result;
    chomp $result;
    $result=~s!\n!<br/>!gs;
    #$result=~s!<br/>$!!;
    my $srpm=$metadata->sourceid($rpm);
    my $packager=$metadata->nick($rpm);
    my $person=$packager;
    $TEST{$test}=1;
    warn "got undef:[$srpm] [$packager] for $rpm" if ! defined $srpm || !defined $packager;
    if ($aclmap) {
	my $srcname=$metadata->name($srpm);
	if (! defined $srcname) {
	    warn "source name is not defined for $srpm";
	} else {
	    my @acls=$aclmap->name2acl($srcname);
	    my $leader=$acls[0];
	    $person=$leader;
	    foreach my $acl (@acls) {
		$ACL2TEST->set([$acl,$person,$rpm,$test],[$status,$result]);
	    }
	    $LEADER2TEST->append([$person,$rpm,$test],[$status,$result]);
	}
    }
    $TEST2RPM->set([$test,$status,$rpm],[$result,$person]);
    $RPM2TEST->set([$rpm,$test],[$status,$result,$person]);
    $SRPM2RPM->set([$srpm,$rpm],[1]);
    $PACKAGER2TEST->append([$packager,$rpm,$test],[$status,$result]);
}

my $tmpl_src =q{
<html>
<head><title><TMPL_VAR NAME="HEAD"></title></head>
<body>
<TMPL_IF NAME="H1">
<h1><TMPL_VAR NAME="H1"></h1>
</TMPL_IF>
<table border="1">
<TMPL_LOOP NAME=TABLEHEADER>
<tr>
<TMPL_IF NAME="BALL"><th><TMPL_VAR NAME="BALL"></th></TMPL_IF>
<TMPL_IF NAME="C1"><th><TMPL_VAR NAME="C1"></th></TMPL_IF>
<TMPL_IF NAME="C2"><th><TMPL_VAR NAME="C2"></th></TMPL_IF>
<TMPL_IF NAME="C3"><th><TMPL_VAR NAME="C3"></th></TMPL_IF>
<TMPL_IF NAME="C4"><th><TMPL_VAR NAME="C4"></th></TMPL_IF>
<TMPL_IF NAME="C5"><th><TMPL_VAR NAME="C5"></th></TMPL_IF>
</tr>
</TMPL_LOOP> 
<TMPL_LOOP NAME=TABLEBODY>
<tr>
<TMPL_IF NAME="BALL"><td><img src="}.$img_dir.q{<TMPL_VAR NAME="BALL">.png"></td></TMPL_IF>
<TMPL_IF NAME="C1"><td><TMPL_VAR NAME="C1"></td></TMPL_IF>
<TMPL_IF NAME="C2"><td><TMPL_VAR NAME="C2"></td></TMPL_IF>
<TMPL_IF NAME="C3"><td><TMPL_VAR NAME="C3"></td></TMPL_IF>
<TMPL_IF NAME="C4"><td><TMPL_VAR NAME="C4"></td></TMPL_IF>
<TMPL_IF NAME="C5"><td><TMPL_VAR NAME="C5"></td></TMPL_IF>
</tr>
</TMPL_LOOP> 
</table>
<hr/>
<TMPL_VAR NAME="BOTTOM_COMMENT">
</body>
</html>
};

my $headerstr='Repocop reports ';

my @tests=sort keys %TEST;

my @table;
if ($by_test) {
    my $dir_by_test=&prepare_report_subdir('test');
    &_copy_images($dir_by_test);
    foreach my $test (sort $TEST2RPM->keys_at([])) {
	@table=();
	foreach my $status (sort $TEST2RPM->keys_at([$test])) {
	    foreach my $rpm (sort $TEST2RPM->keys_at([$test,$status])) {
		my ($result)=$TEST2RPM->get([$test,$status,$rpm]);
		push @table, {BALL=>$status, C1=> $status, C2=> $rpm, C3=>$result};
	    }
	}
	&output_tmpl($headerstr.'by test',
		     "$dir_by_test/$test.html",
		     {C1=>'Status',C2=>'rpm id',C3=>'message'},
		     \@table);
    }
}

if ($by_srpm) {
    my $dir_by_srpm=&prepare_report_subdir('srpm');
    &_copy_images($dir_by_srpm);
    foreach my $srpm (sort $SRPM2RPM->keys_at([])) {
	@table=();
	my @rpms = sort $SRPM2RPM->keys_at([$srpm]);
	foreach my $rpm (@rpms) {
	    foreach my $test (@tests) {
		my ($status,$result)= $RPM2TEST->get([$rpm,$test]);
		push @table, {BALL=>$status, C1=> $rpm, C2=> $test, C3=> $status, C4=>$result} if $status;
	    }
	}
	&output_tmpl($headerstr.'by srpm',
		     "$dir_by_srpm/$srpm.html",
		     {C1=>'rpm id',C2=>'test',C3=>'Status',C4=>'message'},
		     \@table);
    }
}

if ($by_acl and $aclmap) {
    my $dir_by_acl=&prepare_report_subdir('acl');
    &_copy_images($dir_by_acl);
    foreach my $acl (sort $ACL2TEST->keys_at([])) {
	@table=();
	my @packager = sort $ACL2TEST->keys_at([$acl]);
	foreach my $packager (@packager) {
	    my @rpms = sort $ACL2TEST->keys_at([$acl,$packager]);
	    foreach my $rpm (@rpms) {
		my @tests = sort $ACL2TEST->keys_at([$acl,$packager,$rpm]);
		foreach my $test (@tests) {
		    my ($status,$result)=$ACL2TEST->get([$acl,$packager,$rpm,$test]);
		    push @table, {BALL=>$status, C1=>$packager, C2=> $rpm, C3=> $test, C4=> $status, C5=>$result};
		}
	    }
	}
	&output_tmpl($headerstr.'by acl',
		     "$dir_by_acl/$acl.html",
		     {C1=>'packager',C2=>'rpm id',C3=>'test',C4=>'Status',C5=>'message'},
		     \@table);
    }
}

if ($by_packager) {
    &__triplet_by_1($PACKAGER2TEST,'packager');
}

if ($by_leader and $aclmap) {
    &__triplet_by_1($LEADER2TEST,'leader');
}

sub __triplet_by_1 {
    my ($KEYSTORE,$subdirname)=@_;
    my $dir_by_packager=&prepare_report_subdir($subdirname);
    &_copy_images($dir_by_packager);
    foreach my $person (sort $KEYSTORE->keys_at([])) {
	my @rpms = sort $KEYSTORE->keys_at([$person]);
	@table=();
	foreach my $rpm (@rpms) {
	    my @tests = sort $KEYSTORE->keys_at([$person,$rpm]);
	    foreach my $test (@tests) {
		my ($status,$result)=$KEYSTORE->get([$person,$rpm,$test]);
		push @table, {BALL=>$status, C1=> $rpm, C2=> $test, C3=> $status, C4=>$result};
	    }
	}
	&output_tmpl($headerstr.'for '.$subdirname.' '.$person,
		     "$dir_by_packager/$person.html",
		     {C1=>'rpm id',C2=>'test',C3=>'Status',C4=>'message'},
		     \@table);
    }
}

sub prepare_report_subdir {
    my ($name)=@_;
    print "by $name...\n" if $verbose;
    my $dir_by_name="$repocop_reportdir/by-$name";
    rmtree([$dir_by_name]);
    mkpath([$dir_by_name]);
    return $dir_by_name;
}

sub output_tmpl {
    my ($header,$file,$headersref,$tableref)=@_;
    open (CURFILE, ">", $file); #, print_to=>*CURFILE does not work :(
    my $tmpl = HTML::Template::Pro->new(scalarref => \$tmpl_src);
    $tmpl->param(HEAD=>$header);
    $tmpl->param(H1=>$header);
    $tmpl->param(TABLEBODY=>$tableref);
    $tmpl->param(TABLEHEADER=>[{BALL=>'&nbsp;',%$headersref}]);
    $tmpl->param(BOTTOM_COMMENT=>'generated by repocop at '.localtime());
    print CURFILE $tmpl->output();
    close (CURFILE);
}

sub _copy_images {
    my $dirprefix=shift;
    my $dir=$dirprefix.'/'.$img_dir;
    mkpath([$dir]);
    foreach my $img (qw/fail warn info experimental ok/) {
	system('cp','/usr/share/repocop/html/'.$img.'.png',$dir)==0 or warn "copy /usr/share/repocop/html/${img}.png $dir failed: $!";
    }
}

print "done.\n" if $verbose;

=head1	NAME

repocop-report-html - a tool that creates html reports on repocop unit tests results.

=head1	SYNOPSIS

B<repocop-report-html>
[B<-h|--help>]
[B<-v|--verbose>]
[B<-q|--quiet>]
[B<-c|--cachedir> I<cachedir>]
[B<--et|--exclude-test> I<comma separated list of tests>]
[B<--it|--include-test> I<comma separated list of tests>]
[B<--ep|--exclude-packager> I<comma separated list of packager's nicks>]
[B<--ip|--include-packager> I<comma separated list of packager's nicks>]
[B<--pkgcollectors-dir> I<comma separated list of local collectors' dirs>]
[B<--srccollectors-dir> I<comma separated list of local collectors' dirs>]
[B<--pkgtests-dir> I<comma separated list of local tests' dirs>]
[B<--srctests-dir> I<comma separated list of local tests' dirs>]
[B<--ex|--except>] 
[B<-g|--given>] 
[B<-l|--last-run>] 
[B<--newer>] I<filename>
[B<-r|--report> <s[kip]|o[k]|w[arn]|f[ail]>]
[I<DIR>...] [I<FILE>...]

=head1	DESCRIPTION

B<repocop-report-html> processes results of repocop unit tests, created with 
repocop-run command, stored in <cachedir> and creates results in html form.
Presize subset of tests can be selected using B<--include>
and B<--exclude> options.

=head1	OPTIONS

=over

=item	B<-r, --report> I<skip|experimental|ok|warn|fail>]

The level of test results reported. Test results below this level
are not reported. Default is warn.

=item	B<-c,--cachedir> I<dir>

Provides alternative location for cachedir. 
Repocop cachedir is a place where test results and 
packages metadata information are stored.

=item	B<--except>, B<--given>

Control processing of rpm arguments. 
B<--given> (default) means processing only given rpm arguments.
B<--except>  means processing all data except given rpm arguments.

=item	B<--et, --exclude-test> I<comma separated list of tests>

Report all processed tests exept the given excluded set.

=item	B<--it, --include-test> I<comma separated list of tests>

Report the given set of tests.

=item	B<--ep, --exclude-packager> I<comma separated list of tests>

=item	B<--it, --include-packager> I<comma separated list of tests>

Exclude/include packages according to Packager: tag.

=item [B<--pkgcollectors-dir> I<comma separated list of local collectors' dirs>]

=item [B<--srccollectors-dir> I<comma separated list of local collectors' dirs>]

=item [B<--pkgtests-dir> I<comma separated list of local tests' dirs>]

=item [B<--srctests-dir> I<comma separated list of local tests' dirs>]

Append user's local tests and collectors to repocop.

=item	B<-h, --help>

Display this help and exit.

=item	B<-v, --verbose>, B<-q, --quiet>

Verbosity level. Multiple -v increase the verbosity level, -q sets it to 0.

=item	B<-l, --last-run>

Use the set of packages processed at last run as an argument.

=item	B<--newer> I<filename>

Process packages newer then I<filename> only.
Note: this filtering does not apply to B<--last-run> option.

=item	B<--acl-file> I<file>

the argument is /path/to/Sisyphus/files/list/list.src.classic
This option is ALTLinux-specific. The file content is ACL db,
which is used to sort result by ALTLinux ACL.


=back

=head1	AUTHOR

Written by Igor Vlasenko <viy@altlinux.org>.

=head1	ACKNOWLEGEMENTS

To Alexey Torbin <at@altlinux.org>, whose qa-robot package
had a strong influence on repocop. 

=head1	COPYING

Copyright (c) 2008 Igor Vlasenko, ALT Linux Team.

This is free software; you can redistribute it and/or modify it under the terms
of the GNU General Public License as published by the Free Software Foundation;
either version 2 of the License, or (at your option) any later version.

=cut

