#!/usr/bin/perl -w

## Fill in the appropriate $path_to_go
## after running, commit go/www/annotation_qc.html
## to alter the page contents, edit
## go/quality_control/annotation_checks/annotation_qc.xml
## to alter the page structure, edit go/www/rule.tmpl

use strict;
use warnings;

#use Test::More qw(no_plan);
use XML::LibXML;
use Template;
use Carp qw/croak/;
use Data::Dumper;
use DateTime::Format::Strptime;

our $verbose = $ENV{VERBOSE} || 1;
##

my $path_to_go = "/Users/gouser/";
my $file = $path_to_go."go/quality_control/annotation_checks/annotation_qc.xml";
my $template_include_paths = [ $path_to_go."go/www/" ];
my $output = $path_to_go."go/www/annotation_qc.html";
my $old_output = $output."-old";
if (-e $output)
{	## move it
	`mv $output $old_output`;
}

print STDERR "Starting script...\n";

my $rules = parse_xml( file => $file );

#exit(0);

my $tmpl_vars;
my $sort_by_status = 1;

my $status_order = {
	Implemented => 1,
	Approved => 2,
	Proposed => 3,
	Deprecated => 4
};

my $status_list = [ [ 'Implemented', [] ] ];


if ($sort_by_status)
{
	my @sorted =
	map {
		my ($n, $r, $s) = split("\0", $_, 3);

		if ($status_list->[-1][0] eq $s)
		{	push @{$status_list->[-1][1]}, $rules->{$r};
		}
		else
		{	push @$status_list, [ $s, [ $rules->{$r} ] ];
		}
		$rules->{$r};
	}
	sort
	map { $status_order->{ $rules->{$_}{status} } . "\0" . $rules->{$_}{id} . "\0" . $rules->{$_}{status} } keys %$rules;

	$rules = [ @sorted ];
}

$tmpl_vars->{rules} = $rules;
$tmpl_vars->{status_list} = $status_list;

## add the data to the template
## GO!!
my $tt = Template->new({
	INCLUDE_PATH => $template_include_paths,
}) || die "$Template::ERROR\n";

$tt->process('rule.tmpl', $tmpl_vars, $path_to_go.'go/www/annotation_qc.html')
    || warn $tt->error(), "\n";

if (! -e $output)
{	`mv $old_output $output`;
}
else
{	`rm $old_output`;
}

my $domain = 'http://www.geneontology.org/';
# my $domain = 'http://127.0.0.1/go/';
print "Location: ".$domain ."GO.annotation_qc.shtml\n\n";

exit(0);

sub parse_xml {
	my %args = (@_);
	my $parser = XML::LibXML->new();
	my $tree = $parser->parse_file( $args{file} );

	my $ruleset;
	foreach my $rule ( $tree->findnodes('//rule') )
	{	my $r;
		foreach my $x qw(title id status)
		{	$r->{$x} = rmv_whtspc( $rule->findvalue('./'.$x) );
		}
		foreach my $c ( $rule->findnodes('./contact') )
		{	push @{$r->{contact_list}}, rmv_whtspc($c->textContent);
		}
		my $descr = ($rule->findnodes('./description'))[0];
		if ($descr->hasAttributes && $descr->getAttribute('format') eq 'html')
		{
			$r->{html_description} = rmv_whtspc( $descr->textContent );
		}
		else
		{	$r->{description} = rmv_whtspc( $rule->findvalue('./description') );
		}
		if ( ($rule->findnodes('./status'))[0]->hasAttribute('date') )
		{	my $d = ($rule->findnodes('./status'))[0]->getAttribute('date');
			my $dt = new DateTime::Format::Strptime( pattern => '%F');
			my $dt_obj = $dt->parse_datetime($d);
			$dt->pattern('%d %B %Y');
			$r->{date} = $dt->format_datetime($dt_obj);
#			print STDERR "date: $d; " . Dumper($r->{date}) . "\n\n";
		}

		my @impl_list = $rule->findnodes('./implementation_list/implementation');
#		print STDERR $r->{id} . ": found " . (scalar @impl_list). " implementations!\n";
		foreach (@impl_list)
		{	my $i;
			if ($_->hasAttribute('status') && $_->getAttribute('status') eq 'active')
			{	$i->{active_impl} = 1;
			}
			if ($_->exists('./script'))
			{	#print STDERR $r->{id} . ": found a script node!\n";
				## find the language
				my $s_node = ($_->findnodes('./script'))[0];
				$i->{lang} = $s_node->getAttribute('language');
				if ( $s_node->hasAttribute('source') )
				{	$i->{source} = $s_node->getAttribute('source');
				}
				else
				{	## do we want to show the actual code?
					$i->{code} = rmv_whtspc( $s_node->textContent );
				}
			}
			if ($_->exists('./input'))
			{	foreach ( $_->findnodes('./input') )
				{	if ($_->hasAttribute('schema'))
					{	$i->{schema} = $_->getAttribute('schema');
					}
					if ($_->hasAttribute('format'))
					{	push @{$i->{format_list}}, $_->getAttribute('format');
					}
				}
			}
			if ($_->exists('./output'))
			{	my $o_node = ( $_->findnodes('./output') )[0];
				$i->{output} = rmv_whtspc( $o_node->textContent );
			}
			if ($_->exists('./when_performed'))
			{	my $p_node = ($_->findnodes('./when_performed'))[0];
				$i->{when} = rmv_whtspc( $p_node->textContent );
			}
			if ($i->{active_impl})
			{	unshift @{$r->{impl_list}}, $i;
			}
			else
			{	push @{$r->{impl_list}}, $i;
			}
		}
#		print STDERR "impl_list: " . Dumper($r->{impl_list}) . "\n";
		$ruleset->{ $r->{id} } = $r;
#		print STDERR "rule: " . Dumper($r) . "\n\n";

	}
	return $ruleset;
}

sub rmv_whtspc {
	my $val = shift;
	my $new = $val;
	$new =~ s/^\s*//g;
	$new =~ s/\s*$//g;
	return $new;
}

sub rmv_all_whtspc {
	my $val = shift;
	$val =~ s/\s//g;
	return $val;
}