[Bio] / FigWebServices / HOPSS.cgi Repository:
ViewVC logotype

View of /FigWebServices/HOPSS.cgi

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.1 - (download) (annotate)
Sat Sep 24 14:25:13 2005 UTC (14 years, 2 months ago) by overbeek
Branch: MAIN 
the HOPSS stuff for the prototype web site

# -*- perl -*-

use FIG;
my $fig = new FIG;

use URI::Escape;  # uri_escape()
use HTML;
use CGI;

my $cgi = new CGI;
if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/hopss_parms`));
    $cgi = $VAR1;
#   print STDERR &Dumper($cgi);
}

if (0)
{
    print $cgi->header;
    my @params = $cgi->param;
    print "<pre>\n";
    foreach $_ (@params)
    {
	print "$_\t:",join(",",$cgi->param($_)),":\n";
    }

    if (0)
    {
	if (open(TMP,">/tmp/hopss_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}

my $html = [];
push @$html, "<TITLE>HOPSS</TITLE>\n"; 

my $request = $cgi->param('request');
    
if (! $request)
{
    push(@$html,$cgi->br,
	        $cgi->h1("Welcome to <a href=Html/about_HOPSS.html target=help>HOPSS</a> database"),$cgi->br,
	        $cgi->h2("A Public Depository of Open Problems and Conjectures Identified by SubSystem analysis"),
                "<br><br>\n"
	 );

    push(@$html,&summary($fig,$cgi));
    push(@$html, $cgi->hr,
	 "<a href=HOPSS.cgi?request=new_problem>New Problem</a>\n"
	 );
}
else
{
    if ($request eq "new_problem")
    {
	&add_problem_form($fig,$cgi,$html),
    }
    elsif ($request eq "add_problem")
    {
	&add_problem($fig,$cgi,$html);
	push(@$html,$cgi->h1('added'));
	push(@$html,&summary($fig,$cgi));
	push(@$html, $cgi->hr,
	             "<a href=HOPSS.cgi?request=new_problem>New Problem</a>\n"
	     );
    }
    elsif (($request eq "show_problem") && ($problem = $cgi->param('problem')))
    {
	&show_problem($fig,$cgi,$html,$problem);
    }
    elsif (($request eq "update_problem") && ($problem = $cgi->param('problem')))
    {
	&update_problem($fig,$cgi,$html,$problem);
    }
}
&HTML::show_page($cgi,$html);

sub show_problem {
    my($fig,$cgi,$html,$problem) = @_;

    &load_form($fig,$cgi,$problem);
    &update_form($fig,$cgi,$html,$problem);
}

sub load_form {
    my($fig,$cgi,$problem) = @_;

    my $kv = &read_problem($problem);
    foreach $name (keys(%$kv))
    {
	my $val = $kv->{$name};
	$cgi->param(-name => $name, -value => $val);
    }
}

sub update_problem {
    my($fig,$cgi,$html,$problem) = @_;

    &write_problem($cgi,$problem);
    &update_form($fig,$cgi,$html,$problem);
}

sub update_form {
    my($fig,$cgi,$html,$problem) = @_;


    my(@types) = ('Missing gene for a role',
		  'Gene in subsystem without clear role',
		  'Role out of context',
		  'Missing input/output',
		  'Functionally coupled hypothetical',
		  'Orphan chromosomal cluster',
		  'Unresolved paralogs',
		  'other');
  
    my $type        = &parameter($cgi,"type");
    my $title       = &parameter($cgi,'title');
    my $subsystem   = &parameter($cgi,'subsystem');
    my $who         = &parameter($cgi,'who');
    my $description = &parameter($cgi,'description');

    my @conjectures = grep { $_ } &parameter($cgi,'conjecture');
    my @comments    = grep { $_ } &parameter($cgi,'comment');

    push(@$html,$cgi->start_form(-action => "HOPSS.cgi", -method => 'post'),
	        $cgi->hidden(-name => 'request', -value => 'update_problem', -override => 1),
	        $cgi->hidden(-name => 'subsystem', -value => $subsystem, -override => 1),
	        $cgi->hidden(-name => 'problem', -value => $problem, -override => 1),
	        $cgi->br,
	        $cgi->br,
	        $cgi->br,
	        "<a href=Html/HOPSS_type.html target=help><b>Help on How to Pick Types</b></a>\n",
	        $cgi->br,
 	        $cgi->scrolling_list(-name => 'type', -values => \@types, -default => $type, -size => 5),
	        $cgi->br,
	        $cgi->br,
	        $cgi->br,
	        'Title: ',$cgi->textfield(-name => 'title', -default => $title, -size=>60),
	        $cgi->br,
	        $cgi->br,
	        "Subsystem: $subsystem <br><br>\n",
	        $cgi->br,
	        $cgi->br,
	        'Your Name: ',$cgi->textfield(-name => 'who', -default => $who, -size=>60),
	        $cgi->br,
	        $cgi->br,
#	        'Approximate number of genomes: ',$cgi->textfield(-name => 'num_genomes', -default => '', -size=>60),
#	        $cgi->br,
#	        $cgi->br,
	        'Description of the Problem',
	        $cgi->br,
	        $cgi->br,
	        $cgi->textarea(-name => 'description', -rows => 20, -cols => 100, -value => $description),
	        $cgi->br,
	        $cgi->br
	 );
    foreach $_ (@conjectures,'')
    {
	push(@$html,"Conjecture: ",$cgi->br,
	            $cgi->textarea(-name => 'conjecture', -rows => 20, -cols => 100, -value => $_, -override => 1),
	            $cgi->br,
	            $cgi->br
	     );
    }

    foreach $_ (@comments,'')
    {
	push(@$html,"Comment: ",$cgi->br,
	            $cgi->textarea(-name => 'comment', -rows => 20, -cols => 100, -value => $_, -override => 1),
	            $cgi->br,
	            $cgi->br
	     );
    }

    push(@$html,
	        $cgi->submit('Update the Problem'),
	        $cgi->end_form
	 );
}



sub summary {
    my($fig,$cgi) = @_;

    my @existing = &problems;
    if (@existing > 0)
    {
	my $col_hdrs = ['title','subsystem','type','timestamp','who','conjectures','comments'];
	my $tab = [];

	my $problem;
	foreach $problem (@existing)
	{
	    $kv = &read_problem($problem );

	    push(@$tab,[
			&problem_link($cgi,&title($kv),$problem),
			&subsystem($kv),
			&type($kv),
			&time_of_creation($kv),
			&who($kv),
			&num_conjectures($kv),
			&num_comments($kv)
			]);
	}
	return &HTML::make_table($col_hdrs,[sort { ($a->[1] cmp $b->[1]) } @$tab],"Summary of Existing Problems and Conjectures");
    }
    else
    {
	return $cgi->br;
    }
}

sub problem_link {
    my($cgi,$title,$problem) = @_;

    return "<a href=HOPSS.cgi?request=show_problem&problem=$problem>$title</a>\n";
}

sub type {
    my($kv) = @_;

    return $kv->{'type'}->[0];
}

sub time_of_creation {
    my($kv) = @_;

    return $fig->epoch_to_readable($kv->{'time_of_creation'}->[0]);
}

sub title {
    my($kv) = @_;

    return $kv->{'title'}->[0];
}

sub subsystem {
    my($kv) = @_;

    return $kv->{'subsystem'}->[0];
}

sub who {
    my($kv) = @_;

    return $kv->{'who'}->[0];
}

sub num_conjectures {
    my($kv) = @_;

    my $x = @{$kv->{'conjecture'}};
    return $x ? scalar @$x : 0;
}

sub num_comments {
    my($kv) = @_;

    my $x = @{$kv->{'comment'}};
    return $x ? scalar @$x : 0;
}

sub read_problem {
    my($problem) = @_;
    
    my $kv = undef;
    if (open(PROB,"<$FIG_Config::data/HOPSS/$problem/problem"))
    {
	$/ = "\n//\n";
	while ($_ = <PROB>)
	{
	    chomp;
	    if ($_ =~ /^(\S+)\n(.*)/s)
	    {
		push(@{$kv->{$1}},$2);
	    }
	}
	$/ = "\n";
	close(PROB);
    }
    return $kv;
}

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

    &FIG::verify_dir("$FIG_Config::data/HOPSS");
    
    my @existing = &problems;
    my $new_prob = &next_id(\@existing);
    &write_problem($cgi,$new_prob);
}

sub write_problem {
    my($cgi,$new_prob) = @_;

    &FIG::verify_dir("$FIG_Config::data/HOPSS/$new_prob");
    if (-s "$FIG_Config::data/HOPSS/$new_prob/problem")
    {
	my $timestamp = time;
	rename("$FIG_Config::data/HOPSS/$new_prob/problem",
	       "$FIG_Config::data/HOPSS/$new_prob/Backup/problem.$timestamp");
    }
    &FIG::verify_dir("$FIG_Config::data/HOPSS/$new_prob/Backup");
    open(NEW,">$FIG_Config::data/HOPSS/$new_prob/problem") 
	|| die "could not open $FIG_Config::data/HOPSS/$new_prob/problem";

    my $type        = &parameter($cgi,'type');
    my $title       = &parameter($cgi,'title');
    my $subsystem   = &parameter($cgi,'subsystem');
    my $who         = &parameter($cgi,'who');
#   my $num_genomes = &parameter($cgi,'num_genomes');
    my $description = &parameter($cgi,'description');
    my @conjectures = grep { $_ } &parameter($cgi,'conjecture');
    my @comments    = grep { $_ } &parameter($cgi,'comment');

    print NEW "ID\n$new_prob\n//\n";

    print NEW "time_of_creation\n",time,"\n//\n";
    print NEW "type\n$type\n//\n";
    print NEW "title\n$title\n//\n";
    print NEW "subsystem\n$subsystem\n//\n";
    print NEW "who\n$who\n//\n";
#   print NEW "num_genomes\n$num_genomes\n//\n";
    print NEW "description\n$description\n//\n";
    foreach $_ (@conjectures)
    {
	print NEW "conjecture\n$_\n//\n";
    }

    foreach $_ (@comments)
    {
	print NEW "comment\n$_\n//\n";
    }
    close(NEW);
}    

sub problems {

    my @existing = ();
    if (opendir(HOPSS,"$FIG_Config::data/HOPSS"))
    {
	@existing = grep { $_ !~ /^\./ } readdir(HOPSS);
	closedir(HOPSSS);
    }
    return @existing;
}

sub next_id {
    my($existing) = @_;

    my $max = 0;
    foreach $_ (@$existing)
    {
	$max = &FIG::max($max,$_);
    }
    return $max+1;
}

sub parameter {
    my($cgi,$name) = @_;

    if (wantarray)
    {
	my @val = $cgi->param($name);
	if (@val > 0)
	{
	    foreach $_ (@val)
	    {
		$_ =~ s/
/\n/g;
	    }
	}
	else
	{
	    @val = ();
	}
	return @val;
    }
    else
    {
	my $val = $cgi->param($name);
	$val = $val ? $val : "";
	$val =~ s/
/\n/g;
	return $val;
    }
}

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

	my(@types) = ('Missing gene for a role',
		      'Gene in subsystem without clear role',
		      'Role out of context',
		      'Missing input/output',
		      'Functionally coupled hypothetical',
		      'Orphan chromosomal cluster',
		      'Unresolved paralogs',
		      'other');
  
	my @subsystems = sort { uc $a cmp uc $b } $fig->all_subsystems;

	push(@$html,$cgi->h1("Please fill in the relevant fileds"),
	     $cgi->start_form(-action => "HOPSS.cgi", -method => 'post'),
	     $cgi->hidden(-name => 'request', -value => 'add_problem', -override => 1),
	     $cgi->scrolling_list(-name => 'type', -values => \@types, -size => 5),
	     $cgi->br,
	     $cgi->br,
	     $cgi->br,
	     'Title: ',$cgi->textfield(-name => 'title', -default => '', -size=>60),
	     $cgi->br,
	     $cgi->br,
	     $cgi->scrolling_list(-name => 'subsystem', -values => \@subsystems, -size => 5),
	     $cgi->br,
	     $cgi->br,
	     'Your Name: ',$cgi->textfield(-name => 'who', -default => '', -size=>60),
	     $cgi->br,
	     $cgi->br,
#	     'Approximate number of genomes: ',$cgi->textfield(-name => 'num_genomes', -default => '', -size=>60),
#	     $cgi->br,
#	     $cgi->br,
	     'Description of the Problem',
	     $cgi->br,
	     $cgi->br,
	     $cgi->textarea(-name => 'description', -rows => 20, -cols => 100, -value => ''),
	     $cgi->br,
	     $cgi->br,
	     $cgi->submit('Add the Problem'),
	     $cgi->end_form
	     );
}
MCS Webmaster
 ViewVC Help
Powered by ViewVC 1.0.3