#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
# 
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#

### start

use FIG;
use FIG_CGI;
use CGI::Carp qw(fatalsToBrowser); # this makes debugging a lot easier by throwing errors out to the browser

use strict;
use Tracer;
use FIGjs          qw( toolTipScript );
use HTML;

my($fig, $cgi, $user);

eval {
    ($fig, $cgi, $user) = FIG_CGI::init(debug_save => 0,
					debug_load => 0,
					print_params => 0);
};

if ($@ ne "")
{
    my $err = $@;

    my(@html);

    push(@html, $cgi->p("Error connecting to SEED database."));
    if ($err =~ /Could not connect to DBI:.*could not connect to server/)
    {
        push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
    }
    else
    {
        push(@html, $cgi->pre($err));
    }
    &HTML::show_page($cgi, \@html, 1);
    exit;
}

Trace("Connected to FIG.") if T(2);

my $html = [];
unshift @$html, "<TITLE>The SEED Selected Collections</TITLE>\n";
my $userhtml;
if ($user) {$userhtml=$cgi->hidden(-name=>"user")} else {$userhtml=$cgi->p("Please enter your username: ", $cgi->textfield(-name=>"user", -size=>30))}

my $allss; # a global variable that has all subsystems and genomes so we don't have to reload them each time
if ($cgi->param("add_and_delete")) 
{
    $html=&add_and_delete($cgi, $html);
    $html=choose_genomes($cgi, $html);
}
elsif ($cgi->param("choose_genomes"))
{
    $html=choose_genomes($cgi, $html);
}
else
{
    $html=&show_initial($cgi, $html);
}

&HTML::show_page($cgi,$html,1);
exit;

sub choose_genomes {
    my ($cgi, $html)=@_;
   
    my $collection=&collection($cgi);
    
    # Get the objects in this collection.
    my %got;
    my %gotss;
    my @data = $fig->get_attributes(undef, 'collection', $collection);
    for my $dataRow (@data) {
        if ($dataRow->[0] =~ /^\d+\.\d+$/) {
            $got{$dataRow->[0]} = 1;
        } else {
            $gotss{$dataRow->[0]} = 1;
        }
    }
    # now find all other genomes
    my @missinggenomes=grep {!$got{$_}} $fig->genomes("Complete");
    my $gs;
    map {$gs->{$_}=$fig->genus_species($_)} @missinggenomes, keys %got;

    # now define the subsystems that we want
    my @missingss = grep {!$gotss{$_}} $fig->all_subsystems;

    my $sslabels;
    map {$sslabels->{$_}=$_; $sslabels->{$_}=~s/\_/ /g} @missingss, keys %gotss;
   
    Trace(join(" :: ", "GOT SS HAS KEYS", keys %gotss, "\nVALUES\n", values %gotss, "\n")) if T(3);
    
    push @$html,
         $cgi->start_form(),
         $cgi->hidden(-name=>"selection"),
         $userhtml,
         $cgi->h2("Selected Genomes For ", &collection_name($cgi)), 
         $cgi->p("These are the genomes and subsystems that are currently chosen for <b>", &collection_name($cgi), "</b>:"),
         $cgi->div({class=>"help"}, "The lists on the left show the selected genomes and subsystems, and the lists on the right show the remaining ones. To remove from the selected lists, highlight one or more genomes and/or subsystems on the left and click the \"Add and Delete Genomes and Subsystems\" button. To add genomes, highlight one or more genomes and/or subsystems on the right, and click the same button."),
         "<table>\n<tr>\n<th>Selected Genomes (", scalar(keys %got), " total)</th><th>Remaining Genomes (", scalar(@missinggenomes), " total)</th></tr>",
         "<tr><td>\n",
         $cgi->scrolling_list( -name     => 'got_genomes',
                 -values   => [sort {$gs->{$a} cmp $gs->{$b}} keys %got],
                 -labels   => $gs,
                 -size     => 10,
                 -multiple => 1,
                 -defaults  => [],
                 ), "\n</td><td>\n",
         $cgi->scrolling_list( -name     => 'other_genomes',
                 -values   => [sort {$gs->{$a} cmp $gs->{$b}} @missinggenomes], 
                 -labels   => $gs,
                 -size     => 10,                                                                                            
                 -multiple => 1,
                 -defaults  => [],
                 ), "\n",
         "</td></tr>\n",
         "<tr><th>Selected Subsystems (", scalar(keys %gotss), " total)</th><th>Remaining Subsystems (", scalar(@missingss), " total)</th></tr>\n",
         "<tr><td>\n",
         $cgi->scrolling_list( -name     => 'got_subsystems',
                 -values   => [sort {uc($sslabels->{$a}) cmp uc($sslabels->{$b})} keys %gotss],
                 -labels   => $sslabels,
                 -size     => 10,
                 -multiple => 1,
                 -defaults  => [],
                 ), "\n</td><td>\n",
         $cgi->scrolling_list( -name     => 'other_subsystems',
                 -values   => [sort {uc($sslabels->{$a}) cmp uc($sslabels->{$b})} @missingss],
                 -labels   => $sslabels,
                 -size     => 10,
                 -multiple => 1, 
                 -defaults  => [],
                 ), "\n</td></tr>\n</table>",
         $cgi->p, $cgi->submit("update", "Return to Table"), $cgi->submit("add_and_delete", "Add and Delete Genomes and Subsystems"), $cgi->reset,
         $cgi->end_form;

    return $html;
}




sub add_and_delete {
    my ($cgi, $html)=@_;
    foreach my $genome ($cgi->param("got_genomes"))
    {
     # these are the ones to DELETE
     $fig->delete_attribute($genome, 'collection', &collection($cgi));
     push @$html, $cgi->h3("Genome ". $fig->genus_species($genome) . " ($genome) was <i>DELETED FROM</i> the Selected list\n");
    }
    foreach my $genome ($cgi->param("other_genomes"))
    {
        # these are the ones to ADD
        $fig->add_attribute($genome, 'collection', &collection($cgi));
        push @$html, $cgi->h3("Genome ". $fig->genus_species($genome) . " ($genome) was <i>ADDED TO</i> the Selected list\n");
    }
    foreach my $subsystem ($cgi->param("got_subsystems"))
    {
     # these are the ones to DELETE
        next unless ($subsystem);
        my $coll=&collection($cgi);
        next unless ($coll);
        $fig->delete_attribute($subsystem, 'collection', $coll);
        push @$html, $cgi->h3("Subsystem $subsystem was <i>DELETED FROM</i> the Selected list\n");
    }
    foreach my $subsystem ($cgi->param("other_subsystems"))
    {
        # these are the ones to ADD
        next unless ($subsystem);
        my $coll=&collection($cgi);
        next unless ($coll);
        $fig->add_attribute($subsystem, 'collection', $coll);
        push @$html, $cgi->h3("Subsystem $subsystem was <i>ADDED TO</i> the Selected list\n");
    }
    
    return $html;
}


sub show_initial {
    my ($cgi, $html)=@_;

    # what are our genomes and our subsystems?
    my %genomes;
    my %ss;
    my $collection = &collection($cgi);
    Trace("Searching for $collection.") if T(3);
    my @data = $fig->get_attributes(undef, 'collection', $collection);
    Trace(scalar(@data) . " rows found for collection attribute $collection.") if T(3);
    for my $dataRow (@data) {
        if ($dataRow->[0] =~ /^\d+\.\d+$/) {
            $genomes{$dataRow->[0]} = 1;
        } else {
            # there is a weird problem where sometimes the keys have spaces in their names, which of course they should not
            # so in this klutz, I convert them all the real ss names without spaces, and then I make a hash with those where
            # the values are the names with underscores converted back to spaces. oy.
            my $ssName = $dataRow->[0];
            $ssName =~ s/\s+/_/g;
            my $ssKey = $ssName;
            $ssName =~ s/\_/ /g;
            $ss{$ssKey} = $ssName;
        }
    }
    Trace("Sorting genomes.") if T(3);
    my @genomes=sort {$fig->genus_species($a) cmp $fig->genus_species($b)} keys %genomes;
    
    my $result;
    Trace("Formatting table.") if T(3);
    my $tab=[];
    my $colhdrs=["Subsystem", map {$fig->genus_species($_). " ($_)"} @genomes];
    for (my $i=21; $i<=@$colhdrs; $i+=20) {splice(@$colhdrs, $i, 0, "<b>Subsystem</b>"); $i++}
    my $in_table_hdrs; 
    map {push @$in_table_hdrs, [$_, "th "]} @$colhdrs;
    my $rowcount=0;
    my $displayby = $cgi->param("displayby");
    foreach my $sub (sort {$ss{$a} cmp $ss{$b}} keys %ss)
    {
        Trace("Reading $sub.") if T(3);
        my $subObject = ($displayby ? $fig->get_subsystem($sub) : undef);
        Trace("Processing row $rowcount.") if T(3);
        my $row=[&HTML::sub_link($cgi, $sub)];
        my %gss;
        Trace("GSS Loop for subsystem $sub.") if T(3);
        foreach my $sg ($fig->subsystem_genomes($sub, 1)) {map {$gss{$_->[0]}=1} @$sg}
        Trace("Genome Loop.") if T(3);
        foreach my $genome (@genomes)
        {
            my $rolecount;
            Trace("Processing $genome.") if T(3);
            if ($gss{$genome}) 
            {
                if ($displayby eq "frs") {$rolecount=&rolecount($subObject, $genome)}
                elsif ($displayby eq "pegs") {$rolecount=&pegcount($subObject, $genome)}
                else {$rolecount=&variantcode($sub, $genome)}
            }
            if (defined $rolecount && $rolecount) {push @$row, $rolecount} 
            elsif (defined $rolecount) {push @$row, [$rolecount, "td bgcolor='#FFCCCC'"]}
            else {push @$row, [" &nbsp; ", "td bgcolor='#CCCCFF'"]}
        }
        Trace("Splice Loop.") if T(3);
        # splice in the row breaks every 20 horizontal positions
        for (my $i=21; $i<=@$row; $i+=20) {splice(@$row, $i, 0, &HTML::sub_link($cgi, $sub)); $i++}
        push @$tab, $row;
        $rowcount++;
        unless ($rowcount % 20) {push @$tab, $in_table_hdrs} 
    }
    Trace("$rowcount rows processed.") if T(3);
    my %displayby=(
        "frs"   => "Number of Functional Roles",
        "pegs"  => "Number of pegs",
        "vc"    => "Variant code",
    );
   

     my %excelfile;
     if ($cgi->param('create_excel')) {$excelfile{excelfile}=&collection($cgi)}
     Trace("Creating html.") if T(3);
     push @$html,
        $cgi->h2("Subsystem coverage for selected genomes and subsystems"),
        $cgi->p("The table below shows the number of <i>functional roles</i> each genome has in each subsystem<br />\n",
        "(i.e. the number of cells that have one or more pegs in them)."),
        $cgi->start_form, 
        $cgi->p($userhtml),
        $cgi->p("Please choose a collection to manage: ", &select_collection($cgi)),
        $cgi->p("Please choose the output to display: ", $cgi->popup_menu(-name=>"displayby", -values=>[keys %displayby], -labels=>\%displayby, -default=>"vc")),
        $cgi->submit("update", "Update Table"), $cgi->submit("add_and_delete", "Add and Delete Genomes or Subsystems"),
        &HTML::make_table($colhdrs, $tab, "Number of Roles Per Genome", %excelfile),
        $cgi->submit("create_excel", "Create excel file"), $cgi->submit("update", "Update Table"), $cgi->submit("add_and_delete", "Add and Delete Genomes or Subsystems"),
        $cgi->div({class=>"diagnostic"}, $result),
        $cgi->end_form();
        
    return $html;
}


=head2 collection()

Get or set the current selection that we are using. If selection is provided we will use that.

=cut 

sub collection {
    my ($cgi, $sel)=@_;
   
    if ($sel) {$cgi->param("selection", $sel)}
    
    $sel=$cgi->param("selection");
    unless ($sel) {$sel="hundred_hundred"}
    return $sel;
}

sub options {
    my %options=(
            "higher_plants"   => "Higher Plants",
            "eukaryotic_ps"   => "Photosynthetic Eukaryotes",
            "nonoxygenic_ps"  => "Anoxygenic Phototrophs",
            "hundred_hundred" => "Hundred by a hundred",
            "functional_coupling_paper" => "Functional Coupling Paper",
            "ecoli_essentiality_paper" => "E. coli Essentiality Paper",
            ); 
}

sub collection_name {
    my ($cgi)=@_;
    my $sel=&collection($cgi);
    my %options=&options();
    return $options{$sel}
}

sub select_collection {
    my  ($cgi)=@_;
    my %options=&options;
    return $cgi->popup_menu(-name=>"selection", -values=>[keys %options], -default=>&collection($cgi), -labels=>\%options);
}


sub rolecount {
    my ($sub, $genome)=@_; 
    my $rolecount=0;
    foreach my $role ($sub->get_roles())
    {
        my @roles = grep { ! $fig->is_deleted_fid($_) } $sub->get_pegs_from_cell($genome, $role);
        $rolecount++ if (@roles);
    }
    return $rolecount;
}


sub pegcount {
    my ($sub, $genome)=@_; 
    my $rolecount=0;
    foreach my $role ($sub->get_roles())
    {
        my @roles = grep { ! $fig->is_deleted_fid($_) } $sub->get_pegs_from_cell($genome, $role);
        $rolecount+= scalar(@roles);
    }
    return $rolecount;
}


sub variantcode {
    my ($sub, $genome)=@_;
    my $retVal;
    if (defined $allss->{$genome}) {
        $retVal = $allss->{$genome}->{$sub};
    } else {
        Trace("Active subsystem search for $genome.") if T(3);
        $allss->{$genome} = $fig->active_subsystems($genome, 1);
        $retVal = $allss->{$genome}->{$sub};
    }
    Trace("Returning \"$retVal\" for $genome in $sub.") if T(3);
    return $retVal;
}