#!/pro/bin/perl

use strict;
use warnings;

sub usage
{
    my $err = shift and select STDERR;
    print "usage: $0\n";
    exit $err;
    } # usage

use Getopt::Long qw(:config bundling nopermute);
my $opt_t = 0;
my $opt_v = 0;
# todo: options to send a range of report id's
GetOptions (
    "help|?"		=> sub { usage (0); },

    "t|test"		=> \$opt_t,
    "v|verbose:1"	=> \$opt_v,
    ) or usage (1);

use DBI;
use JSON::PP;
use Data::Peek;

my %rec;

sub host_from_report
{
    $rec{rpt_header} =~ m/automated smoke.*\n(\w+):/i ? $1 : "?";
    } # host_from_report

sub parallel_from_report
{
    $rec{report} =~ m/harness[-_ ]options.*j[1-9]/i ? 1 : 0;
    } # parallel_from_report

my %weight = qw( ? -1 - 0 O 1 X 2 F 3 t 4 M 5 m 6 c 7 );

my %count;

my $dbh = DBI->connect ("dbi:mysql:database=ts_db", undef, undef, {
    RaiseError         => 1,
    PrintError         => 1,
    AutoCommit         => 1,
    ChopBlanks         => 1,
    ShowErrorStatement => 1,
    FetchHashKeyName   => "NAME_lc",
    }) or die $DBI::errstr;

my $has_json;
eval {
    my $sth = $dbh->prepare ("select * from reports");
       $sth->execute;
    ($has_json) = grep { $_ eq "json" } @{$sth->{NAME_lc}};
    };

$has_json or
    $dbh->do ("alter table reports add column json longtext");

my $stj = $dbh->prepare ("update reports set json = ? where rid = ?");
my $sth = $dbh->prepare ("select * from reports order by rid desc");
   $sth->execute;
   $sth->bind_columns (\@rec{@{$sth->{NAME_lc}}});
REPORT: while ($sth->fetch) {

    $rec{report} or next;

    $count{accepted}++;

    $rec{report} =~ s/\r\n?/\n/g;
    $rec{report} =~ s/\s*\n(?:\s*\n)+\s*/\n\n/g;
    $rec{report} =~ m/^[\s\n]*(.*?)\n(?:\s*?\n)+/s and
	$rec{rpt_header} = $1;

    $rec{plevel} =~ m/^[0-9a-f]+$/ or next;
    $count{with_plevel}++;

    my $report_hash = {
	duration	=> undef,
	config_count	=> undef,
	smoke_perl	=> undef,
	smoke_version	=> undef,
	smoke_revision	=> undef,
	smoker_version	=> undef,
	reporter	=> undef,
	};
    my $id_hash = {
	smoke_date	=> $rec{dtsmoke},
	perl_id		=> $rec{pversion},
	git_id		=> $rec{plevel},
	applied_patches	=> "?",
	};
    my $node_hash = {
	hostname	=> $rec{hostname} || host_from_report,
	architecture	=> $rec{arch},
	osname		=> $rec{os},
	osversion	=> $rec{osver},
	cc		=> $rec{cc},
	ccversion	=> $rec{ccversion},
	user		=> $rec{smoker},
	};
    my $build_hash = {
	TEST_JOBS	=> undef,
	LC_ALL		=> undef,
	LANG		=> undef,
	manifest_msgs	=> "",
	compiler_msgs	=> "",
	skipped_tests	=> undef,
	harness_only	=> 0,
	summary		=> "?",
	};

    my $parallel = parallel_from_report;
    my $output   = $rec{report}; $rec{report} = "";
    my @report   = grep m/\S/ => split m/\n\n/ => $output, -1;

    # Weed out the unused blocks. Data already in database
    foreach my $r (0 .. $#report) {
	$report[$r] =~ m/^Automated\s+smoke\s+report\s+for\s+/i or next;
	splice @report, $r, 1;
	last;
	}

    foreach my $r (0 .. $#report) {
	$report[$r] =~ m/^Summary:\s*\S+$/ or next;
	splice @report, $r, 1;
	last;
	}

    foreach my $r (0 .. $#report) {
	$report[$r] =~ m/^O = OK  F = Failure\(s\)/ or next;
	splice @report, $r, 1;
	last;
	}

    # Fetch single-item information
    foreach my $r (0 .. $#report) {
	$report[$r] =~ s/^Tests\s+skipped\s+on\s+user\s+request\s*:[\s\n]+
	    ( (?:\s+.*\n)+ )//ix or next;
	($build_hash->{skipped_tests} = $1) =~ s/\s+$//;
	last;
	}

    foreach my $r (0 .. $#report) {
	$report[$r] =~ s/^Testsuite\s+was\s+run\s+only\s+with\s+'?harness'?\s*\n*//i or next;
	$build_hash->{harness_only} = 1;
	$report[$r] =~ m/\S/ or splice @report, $r, 1;
	last;
	}

    foreach my $r (0 .. $#report) {
	$report[$r] =~ s/^Locally\s+applied\s+patches:?[\s\n]*//i or next;
	my $lap = splice @report, $r, 1;
	$id_hash->{applied_patches} = join " ", grep m/\S/ =>
	    grep { !m/^SMOKE$rec{plevel}/ } split m/[\s\n]+/ => $lap;
	last;
	}

    foreach my $r (0 .. $#report) {
	$report[$r] =~ s/^--[\s\r\n]+Report\s+by\s+Test::Smoke\s*// or next;

	$report[$r] =~ s/^v?([0-9.]+)\s+// and
	    $report_hash->{smoke_version} = $1;
	$report[$r] =~ s/build\s+([0-9]+)\s*// and
	    $report_hash->{smoke_revision} = $1;
	$report[$r] =~ s/running\s+on\s+perl\s+(\S+)\s*// and
	    $report_hash->{smoke_perl} = $1;

	$report[$r] =~ s/Reporter\s+v?([0-9.]+)\s*// and
	    $report_hash->{reporter} = $1;
	$report[$r] =~ s/Smoker\s+v?([0-9.]+)\s*// and
	    $report_hash->{smoker_version} = $1;

	splice @report, $r, 1;
	last;
	}

    if ($rec{rpt_header} =~ m/^\s*smoketime\s+([^(]+)/m) {
	my ($d, $sec) = ($1, 0);
	$d =~ m/([0-9]+)\s+hour/  and $sec += $1 * 3600;
	$d =~ m/([0-9]+)\s+minut/ and $sec += $1 * 60;
	$report_hash->{duration} = $sec;
	}

    foreach my $r (0 .. $#report) {
	$report[$r] =~ s/^Compiler\s+messages[\s\n]*//i or next;
	my $cmm = splice @report, $r, 1;
	$build_hash->{compiler_msgs} = join "\n",
	    grep m/\S/ => split m/\s*\n+/ => $cmm;
	last;
	}

    if ($rec{rpt_header} =~ m/automated smoke.*\n\w+:\s*(.*)/i) {
	my $cpu = $1;
	if ($cpu =~ s{\s+\(\s*(\S.*?)\s*/\s*(.*?)\s*\)\s*}{}) {
	    $node_hash->{architecture} = $1;
	    my $ncpu = $2;
	    $ncpu =~ m/([0-9]+)\s*cpu/ and $node_hash->{cpu_count} = $1;
	    }
	$node_hash->{cpu_description} = $cpu;
	}

    #DDumper[$id_hash,$node_hash,$build_hash,@report];

    my ($has_dbg, @conf_lines, @conf_x, $common) = (0);
    foreach my $r (0 .. $#report) {
	$report[$r] =~ m/^(?:(\S+)\s+)?Configuration/ or next;
	$id_hash->{git_describe} = $1;
	my $conf_block = splice @report, $r, 1;
	@conf_lines = split m/\s*\n/ => $conf_block;
	$common = $conf_lines[0] =~ m/\(common\)\s*(.*\S)/ ? $1 : "";
	$common eq "none" and $common = "";
	while ($conf_lines[-1] =~ m/^(?:\|\s+|\+)+-+\s+(.*)/) {
	    my $c = $1;
	    pop @conf_lines;
	    $c =~ m/^(?:PERLIO\s*=\s*(\S+)\s*)?(.*?)\s*(-DD?EBUGGING)?\s*$/;
	    push @conf_x, [ $1, $2, undef, $3 ? 1 : 0 ];
	    $conf_x[-1][3] and $has_dbg = 1;
	    $conf_x[-1][1] =~ s/^LC_ALL\s*=\s*(\S+)\s*// and
		($conf_x[-1][0], $conf_x[-1][2]) = ("locale", $1);
	    $conf_x[-1][1] eq "no debugging" and
		$conf_x[-1][1] = ""; # rid = 80127
	    $conf_x[-1][0] ||= "perlio";
	    }
	last;
	}
    @conf_lines or
	die "Eacks, no conf block in $rec{rid}:\n---\n$rec{rpt_header}\n---\n";

    $report_hash->{config_count} = scalar @conf_lines;
    $count{process}++;
    $count{"conf_".scalar@conf_lines}++;

    my $full_output = join "\n\n" => @report;

    my @configs;
    my $now = scalar localtime;
    foreach my $cl (@conf_lines) {
	$cl .= " ";
	foreach my $dbg (0 .. $has_dbg) {
	    printf STDERR "%6d %6d %s\r",
		$rec{rid}, $count{process}, $now;

	    $build_hash->{summary} = "?";
	    $cl =~ m/^((?:[-OFXMm?c]\s+)+)(.*)/ or next;
	    my ($cfg, @summ) = ($2, split m/\s+/ => $1);
	    @summ == @conf_x or next REPORT; # conf mismatch

	    $count{"summ_".scalar@conf_lines}++;

	    # TODO: break up full_output into matching parts

	    my @result;
	    foreach my $i (0 .. $#summ) {
		$conf_x[$i][3] == $dbg or next;

		$weight{$summ[$i]} > $weight{$build_hash->{summary}} and
		    $build_hash->{summary} = $summ[$i];

		push @result, {
		    io_env	=> $conf_x[$i][0],
		    output	=> $full_output,
		    summary	=> $summ[$i],
		    locale	=> $conf_x[$i][2],
		    };
		}

	    push @configs, +{
		parallel  => $parallel,
		debugging => $dbg ? 1 : 0,
		results   => \@result,
		arguments =>
		    join " ", grep m/\S/ => $common, $cfg,
			$dbg ? "-DDEBUGGING" : "",
		};

	    $count{done}++;
	    }
	}

    my $json = JSON::PP->new->utf8 (1)->pretty (0)->encode (+{
        report => {
            duration		=> $report_hash->{duration},
            config_count	=> $report_hash->{config_count},
            smoke_perl		=> $report_hash->{smoke_perl},
            smoke_version	=> $report_hash->{smoke_version},
            smoke_revision	=> $report_hash->{smoke_revision},
            smoker_version	=> $report_hash->{smoker_version},
            reporter		=> $report_hash->{reporter},
	    },
        id => {
	    smoke_date		=> $id_hash->{smoke_date},
	    perl_id		=> $id_hash->{perl_id},
	    git_id		=> $id_hash->{git_id},
            git_describe	=> $id_hash->{git_describe},
	    applied_patches	=> $id_hash->{applied_patches},
	    },
        node => {
            hostname		=> $node_hash->{hostname},
            architecture	=> $node_hash->{architecture},
            cpu_count		=> $node_hash->{cpu_count},
            cpu_description	=> $node_hash->{cpu_description},
            osname		=> $node_hash->{osname},
            osversion		=> $node_hash->{osversion},
            cc			=> $node_hash->{cc},
            ccversion		=> $node_hash->{ccversion},
            username		=> $node_hash->{user},
	    },
        build => {
            TEST_JOBS		=> $build_hash->{TEST_JOBS},
            LC_ALL		=> $build_hash->{LC_ALL},
            LANG		=> $build_hash->{LANG},
            manifest_msgs	=> $build_hash->{manifest_msgs},
            compiler_msgs	=> $build_hash->{compiler_msgs},
            skipped_tests	=> $build_hash->{skipped_tests},
            harness_only	=> $build_hash->{harness_only},
            summary		=> $build_hash->{summary},
	    },
        configs => \@configs,
        _config => {},	# Don't have that here
	});

    #print $json; exit;
    $stj->execute ($json, $rec{rid});
    }

$_->finish for $sth, $stj;
$dbh->disconnect;

DDumper\%count;
