[Bio] / FigKernelPackages / Observation.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Observation.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.40, Thu Sep 20 22:27:20 2007 UTC revision 1.59, Mon Jun 2 05:05:35 2008 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3  use lib '/vol/ontologies';  #use lib '/vol/ontologies';
4  use DBMaster;  use DBMaster;
5  use Data::Dumper;  use Data::Dumper;
6    
7  require Exporter;  require Exporter;
8  @EXPORT_OK = qw(get_objects);  @EXPORT_OK = qw(get_objects get_sims_objects);
9    
10    use WebColors;
11    use WebConfig;
12    
13  use FIG_Config;  use FIG_Config;
14  #use strict;  #use strict;
15  #use warnings;  #use warnings;
16  use HTML;  use HTML;
17    use FFs;
18    
19  1;  1;
20    
 # $Id$  
   
21  =head1 NAME  =head1 NAME
22    
23  Observation -- A presentation layer for observations in SEED.  Observation -- A presentation layer for observations in SEED.
# Line 317  Line 319 
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$scope) = @_;      my ($self,$fid,$fig,$scope) = @_;
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
     my $fig = new FIG;  
326    
327      # call function that fetches attribute based observations      # call function that fetches attribute based observations
328      # returns an array of arrays of hashes      # returns an array of arrays of hashes
# Line 333  Line 334 
334          my %domain_classes;          my %domain_classes;
335          my @attributes = $fig->get_attributes($fid);          my @attributes = $fig->get_attributes($fid);
336          $domain_classes{'CDD'} = 1;          $domain_classes{'CDD'} = 1;
337          get_identical_proteins($fid,\@matched_datasets);          $domain_classes{'PFAM'} = 1;
338          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes);          get_identical_proteins($fid,\@matched_datasets,$fig);
339          get_sims_observations($fid,\@matched_datasets);          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          get_functional_coupling($fid,\@matched_datasets);          get_sims_observations($fid,\@matched_datasets,$fig);
341          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes);          get_functional_coupling($fid,\@matched_datasets,$fig);
342          get_pdb_observations($fid,\@matched_datasets,\@attributes);          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 346  Line 348 
348          if($dataset->{'type'} eq "dom"){          if($dataset->{'type'} eq "dom"){
349              $object = Observation::Domain->new($dataset);              $object = Observation::Domain->new($dataset);
350          }          }
351          if($dataset->{'class'} eq "PCH"){          elsif($dataset->{'class'} eq "PCH"){
352              $object = Observation::FC->new($dataset);              $object = Observation::FC->new($dataset);
353          }          }
354          if ($dataset->{'class'} eq "IDENTICAL"){          elsif ($dataset->{'class'} eq "IDENTICAL"){
355              $object = Observation::Identical->new($dataset);              $object = Observation::Identical->new($dataset);
356          }          }
357          if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){          elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
358              $object = Observation::Location->new($dataset);              $object = Observation::Location->new($dataset);
359          }          }
360          if ($dataset->{'class'} eq "SIM"){          elsif ($dataset->{'class'} eq "SIM"){
361              $object = Observation::Sims->new($dataset);              $object = Observation::Sims->new($dataset);
362          }          }
363          if ($dataset->{'class'} eq "CLUSTER"){          elsif ($dataset->{'class'} eq "CLUSTER"){
364              $object = Observation::Cluster->new($dataset);              $object = Observation::Cluster->new($dataset);
365          }          }
366          if ($dataset->{'class'} eq "PDB"){          elsif ($dataset->{'class'} eq "PDB"){
367              $object = Observation::PDB->new($dataset);              $object = Observation::PDB->new($dataset);
368          }          }
369    
# Line 372  Line 374 
374    
375  }  }
376    
377  =head3 display_housekeeping  =head3 get_sims_objects()
378  This method returns the housekeeping data for a given peg in a table format  
379    This is the B<REAL WORKHORSE> method of this Package.
380    
381  =cut  =cut
 sub display_housekeeping {  
     my ($self,$fid) = @_;  
     my $fig = new FIG;  
     my $content;  
382    
383      my $org_name = $fig->org_of($fid);  sub get_sims_objects {
384      my $org_id   = $fig->orgid_of_orgname($org_name);      my ($self,$fid,$fig,$parameters) = @_;
     my $loc      = $fig->feature_location($fid);  
     my($contig, $beg, $end) = $fig->boundaries_of($loc);  
     my $strand   = ($beg <= $end)? '+' : '-';  
     my @subsystems = $fig->subsystems_for_peg($fid);  
     my $function = $fig->function_of($fid);  
     my @aliases  = $fig->feature_aliases($fid);  
     my $taxonomy = $fig->taxonomy_of($org_id);  
     my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g);  
385    
386      $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">);      my $objects = [];
387      $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);      my @matched_datasets=();
     $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name,&nbsp;&nbsp;$org_id</td></tr>\n);  
     $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);  
     $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n);  
     $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);;  
     $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);  
     if ( @ecs ) {  
         $content .= qq(<tr><td>EC:</td><td>);  
         foreach my $ec ( @ecs ) {  
             my $ec_name = $fig->ec_name($ec);  
             $content .= join(" -- ", $ec, $ec_name) . "<br>\n";  
         }  
         $content .= qq(</td></tr>\n);  
     }  
388    
389      if ( @subsystems ) {      # call function that fetches attribute based observations
390          $content .= qq(<tr><td>Subsystems</td><td>);      # returns an array of arrays of hashes
391          foreach my $subsystem ( @subsystems ) {      get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
392              $content .= join(" -- ", @$subsystem) . "<br>\n";  
393        foreach my $dataset (@matched_datasets) {
394            my $object;
395            if ($dataset->{'class'} eq "SIM"){
396                $object = Observation::Sims->new($dataset);
397          }          }
398            push (@$objects, $object);
399      }      }
400        return $objects;
     my %groups;  
     if ( @aliases ) {  
         # get the db for each alias  
         foreach my $alias (@aliases){  
             $groups{$alias} = &get_database($alias);  
401          }          }
402    
         # group ids by aliases  
         my %db_aliases;  
         foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){  
             push (@{$db_aliases{$groups{$key}}}, $key);  
         }  
403    
404    =head3 display_housekeeping
405    This method returns the housekeeping data for a given peg in a table format
406    
407          $content .= qq(<tr><td>Aliases</td><td><table border="0">);  =cut
408          foreach my $key (sort keys %db_aliases){  sub display_housekeeping {
409              $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n);      my ($self,$fid,$fig) = @_;
410          }      my $content = [];
411          $content .= qq(</td></tr></table>\n);      my $row = [];
     }  
412    
413      $content .= qq(</table><p>\n);      my $org_name = $fig->org_of($fid);
414        my $org_id = $fig->genome_of($fid);
415        my $function = $fig->function_of($fid);
416        #my $taxonomy = $fig->taxonomy_of($org_id);
417        my $length = $fig->translation_length($fid);
418    
419        push (@$row, $org_name);
420        push (@$row, $fid);
421        push (@$row, $length);
422        push (@$row, $function);
423    
424        # initialize the table for commentary and annotations
425        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
426        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
427        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
428        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
429        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
430        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
431        #$content .= qq(</table><p>\n);
432    
433        push(@$content, $row);
434    
435      return ($content);      return ($content);
436  }  }
# Line 447  Line 441 
441  =cut  =cut
442    
443  sub get_sims_summary {  sub get_sims_summary {
444      my ($observation, $fid, $taxes) = @_;      my ($observation, $dataset, $fig) = @_;
     my $fig = new FIG;  
445      my %families;      my %families;
446      my @sims= $fig->nsims($fid,20000,10,"fig");      my $taxes = $fig->taxonomy_list();
447    
448        foreach my $thing (@$dataset) {
449            my ($id, $evalue);
450            if ($thing =~ /fig\|/){
451                $id = $thing;
452                $evalue = -1;
453            }
454            else{
455                next if ($thing->class ne "SIM");
456                $id      = $thing->acc;
457                $evalue  = $thing->evalue;
458            }
459            next if ($id !~ /fig\|/);
460            next if ($fig->is_deleted_fid($id));
461    
462      foreach my $sim (@sims){          my $genome = $fig->genome_of($id);
463          next if ($sim->[1] !~ /fig\|/);          #my ($genome1) = ($genome) =~ /(.*)\./;
464          my $genome = $fig->genome_of($sim->[1]);          my $taxonomy = $taxes->{$genome};
         my ($genome1) = ($genome) =~ /(.*)\./;  
         my $taxonomy = $taxes->{$genome1};  
         #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # use this if the taxonomies have been updated  
465          my $parent_tax = "Root";          my $parent_tax = "Root";
466          my @currLineage = ($parent_tax);          my @currLineage = ($parent_tax);
467            push (@{$families{figs}{$parent_tax}}, $id);
468            my $level = 2;
469          foreach my $tax (split(/\; /, $taxonomy)){          foreach my $tax (split(/\; /, $taxonomy)){
470              push (@{$families{children}{$parent_tax}}, $tax);              push (@{$families{children}{$parent_tax}}, $tax) if ($tax ne $parent_tax);
471                push (@{$families{figs}{$tax}}, $id) if ($tax ne $parent_tax);
472                $families{level}{$tax} = $level;
473              push (@currLineage, $tax);              push (@currLineage, $tax);
474              $families{parent}{$tax} = $parent_tax;              $families{parent}{$tax} = $parent_tax;
475              $families{lineage}{$tax} = join(";", @currLineage);              $families{lineage}{$tax} = join(";", @currLineage);
476              if (defined ($families{evalue}{$tax})){              if (defined ($families{evalue}{$tax})){
477                  if ($sim->[10] < $families{evalue}{$tax}){                  if ($evalue < $families{evalue}{$tax}){
478                      $families{evalue}{$tax} = $sim->[10];                      $families{evalue}{$tax} = $evalue;
479                      $families{color}{$tax} = &get_taxcolor($sim->[10]);                      $families{color}{$tax} = &get_taxcolor($evalue);
480                  }                  }
481              }              }
482              else{              else{
483                  $families{evalue}{$tax} = $sim->[10];                  $families{evalue}{$tax} = $evalue;
484                  $families{color}{$tax} = &get_taxcolor($sim->[10]);                  $families{color}{$tax} = &get_taxcolor($evalue);
485              }              }
486    
487              $parent_tax = $tax;              $parent_tax = $tax;
488                $level++;
489          }          }
490      }      }
491    
# Line 487  Line 496 
496          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
497          $families{children}{$key} = \@out;          $families{children}{$key} = \@out;
498      }      }
499      return (\%families);  
500        return \%families;
501  }  }
502    
503  =head1 Internal Methods  =head1 Internal Methods
# Line 501  Line 511 
511  sub get_taxcolor{  sub get_taxcolor{
512      my ($evalue) = @_;      my ($evalue) = @_;
513      my $color;      my $color;
514      if ($evalue <= 1e-170){        $color = "#FF2000";    }      if ($evalue == -1){            $color = "black";      }
515        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
516      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
517      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
518      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
# Line 518  Line 529 
529  sub get_attribute_based_domain_observations{  sub get_attribute_based_domain_observations{
530    
531      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
532      my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
533    
534      foreach my $attr_ref (@$attributes_ref) {      foreach my $attr_ref (@$attributes_ref) {
 #    foreach my $attr_ref ($fig->get_attributes($fid)) {  
535          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
536          my @parts = split("::",$key);          my @parts = split("::",$key);
537          my $class = $parts[0];          my $class = $parts[0];
538            my $name = $parts[1];
539            #next if (($class eq "PFAM") && ($name !~ /interpro/));
540    
541          if($domain_classes->{$parts[0]}){          if($domain_classes->{$parts[0]}){
542              my $val = @$attr_ref[2];              my $val = @$attr_ref[2];
# Line 535  Line 545 
545                  my $from = $2;                  my $from = $2;
546                  my $to = $3;                  my $to = $3;
547                  my $evalue;                  my $evalue;
548                  if($raw_evalue =~/(\d+)\.(\d+)/){                  if(($raw_evalue =~/(\d+)\.(\d+)/) && ($class ne "PFAM")){
549                      my $part2 = 1000 - $1;                      my $part2 = 1000 - $1;
550                      my $part1 = $2/100;                      my $part1 = $2/100;
551                      $evalue = $part1."e-".$part2;                      $evalue = $part1."e-".$part2;
552                  }                  }
553                    elsif(($raw_evalue =~/(\d+)\.(\d+)/) && ($class eq "PFAM")){
554                        $evalue=$raw_evalue;
555                    }
556                  else{                  else{
557                      $evalue = "0.0";                      $evalue = "0.0";
558                  }                  }
# Line 562  Line 575 
575    
576  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
577    
578      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
579      my $fig = new FIG;      #my $fig = new FIG;
580    
581      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
582    
# Line 573  Line 586 
586                     };                     };
587    
588      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
 #    foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {  
589          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
590          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );          next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
591          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 585  Line 597 
597                  my @value_parts = split(";",$value);                  my @value_parts = split(";",$value);
598                  $dataset->{'cleavage_prob'} = $value_parts[0];                  $dataset->{'cleavage_prob'} = $value_parts[0];
599                  $dataset->{'cleavage_loc'} = $value_parts[1];                  $dataset->{'cleavage_loc'} = $value_parts[1];
 #               print STDERR "LOC: $value_parts[1]";  
600              }              }
601              elsif($sub_key eq "signal_peptide"){              elsif($sub_key eq "signal_peptide"){
602                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
# Line 624  Line 635 
635  =cut  =cut
636    
637  sub get_pdb_observations{  sub get_pdb_observations{
638      my ($fid,$datasets_ref, $attributes_ref) = (@_);      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
639    
640      my $fig = new FIG;      #my $fig = new FIG;
641    
642      foreach my $attr_ref (@$attributes_ref){      foreach my $attr_ref (@$attributes_ref){
     #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) {  
   
643          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
644          next if ( ($key !~ /PDB/));          next if ( ($key !~ /PDB/));
645          my($key1,$key2) =split("::",$key);          my($key1,$key2) =split("::",$key);
# Line 684  Line 693 
693  =cut  =cut
694    
695  sub get_sims_observations{  sub get_sims_observations{
696        my ($fid,$datasets_ref,$fig,$parameters) = (@_);
697    
698      my ($fid,$datasets_ref) = (@_);      my ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter);
699      my $fig = new FIG;      if ($parameters->{flag}){
700      my @sims= $fig->nsims($fid,500,10,"fig");        $max_sims = $parameters->{max_sims};
701      my ($dataset);        $max_expand = $parameters->{max_expand};
702          $max_eval = $parameters->{max_eval};
703      my %id_list;        $db_filter = $parameters->{db_filter};
704      foreach my $sim (@sims){        $sim_order = $parameters->{sim_order};
705          my $hit = $sim->[1];        $group_by_genome = 1 if (defined ($parameters->{group_genome}));
   
         next if ($hit !~ /^fig\|/);  
         my @aliases = $fig->feature_aliases($hit);  
         foreach my $alias (@aliases){  
             $id_list{$alias} = 1;  
706          }          }
707        else{
708          $max_sims = 50;
709          $max_expand = 5;
710          $max_eval = 1e-5;
711          $db_filter = "figx";
712          $sim_order = "id";
713      }      }
714    
715      my %already;      my($id, $genome, @genomes, %sims);
716      my (@new_sims, @uniprot);      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand);
717      foreach my $sim (@sims){      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
718          my $hit = $sim->[1];      my ($dataset);
719          my ($id) = ($hit) =~ /\|(.*)/;  
720          next if (defined($already{$id}));      if ($group_by_genome){
721          next if (defined($id_list{$hit}));        #  Collect all sims from genome with the first occurance of the genome:
722          push (@new_sims, $sim);        foreach $sim ( @tmp ){
723          $already{$id} = 1;          $id = $sim->id2;
724            $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
725            if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
726            push @{ $sims{ $genome } }, $sim;
727          }
728          @tmp = map { @{ $sims{$_} } } @genomes;
729      }      }
730    
731      foreach my $sim (@new_sims){      foreach my $sim (@tmp){
732          my $hit = $sim->[1];          my $hit = $sim->[1];
733          my $percent = $sim->[2];          my $percent = $sim->[2];
734          my $evalue = $sim->[10];          my $evalue = $sim->[10];
# Line 757  Line 773 
773      my ($id) = (@_);      my ($id) = (@_);
774    
775      my ($db);      my ($db);
776      if ($id =~ /^fig\|/)              { $db = "FIG" }      if ($id =~ /^fig\|/)              { $db = "SEED" }
777      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }      elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
778        elsif ($id =~ /^gb\|/)            { $db = "GenBank" }
779      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }      elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
780        elsif ($id =~ /^ref\|/)           { $db = "RefSeq" }
781      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }      elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
782      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }      elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
783      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }      elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
# Line 768  Line 786 
786      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }      elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
787      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }      elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
788      elsif ($id =~ /^img\|/)           { $db = "JGI" }      elsif ($id =~ /^img\|/)           { $db = "JGI" }
789        elsif ($id =~ /^pdb\|/)           { $db = "PDB" }
790        elsif ($id =~ /^img\|/)           { $db = "IMG" }
791        elsif ($id =~ /^cmr\|/)           { $db = "CMR" }
792        elsif ($id =~ /^dbj\|/)           { $db = "DBJ" }
793    
794      return ($db);      return ($db);
795    
# Line 782  Line 804 
804    
805  sub get_identical_proteins{  sub get_identical_proteins{
806    
807      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
808      my $fig = new FIG;      #my $fig = new FIG;
809      my $funcs_ref;      my $funcs_ref;
810    
 #    my %id_list;  
811      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
 #    my @aliases = $fig->feature_aliases($fid);  
 #    foreach my $alias (@aliases){  
 #       $id_list{$alias} = 1;  
 #    }  
   
812      foreach my $id (@maps_to) {      foreach my $id (@maps_to) {
813          my ($tmp, $who);          my ($tmp, $who);
814          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {          if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
 #        if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) {  
815              $who = &get_database($id);              $who = &get_database($id);
816              push(@$funcs_ref, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
817          }          }
818      }      }
819    
     my ($dataset);  
820      my $dataset = {'class' => 'IDENTICAL',      my $dataset = {'class' => 'IDENTICAL',
821                     'type' => 'seq',                     'type' => 'seq',
822                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 822  Line 836 
836    
837  sub get_functional_coupling{  sub get_functional_coupling{
838    
839      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$fig) = (@_);
840      my $fig = new FIG;      #my $fig = new FIG;
841      my @funcs = ();      my @funcs = ();
842    
843      # initialize some variables      # initialize some variables
# Line 840  Line 854 
854                       [$sc,$neigh,scalar $fig->function_of($neigh)]                       [$sc,$neigh,scalar $fig->function_of($neigh)]
855                    } @fc_data;                    } @fc_data;
856    
     my ($dataset);  
857      my $dataset = {'class' => 'PCH',      my $dataset = {'class' => 'PCH',
858                     'type' => 'fc',                     'type' => 'fc',
859                     'fig_id' => $fid,                     'fig_id' => $fid,
# Line 951  Line 964 
964      return $self->{database};      return $self->{database};
965  }  }
966    
 sub score {  
   my ($self) = @_;  
   
   return $self->{score};  
 }  
   
967  ############################################################  ############################################################
968  ############################################################  ############################################################
969  package Observation::PDB;  package Observation::PDB;
# Line 982  Line 989 
989  =cut  =cut
990    
991  sub display{  sub display{
992      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
993    
994      my $fid = $self->fig_id;      my $fid = $self->fig_id;
995      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
996                                    -host     => $WebConfig::DBHOST,
997                                    -user     => $WebConfig::DBUSER,
998                                    -password => $WebConfig::DBPWD);
999    
1000      my $acc = $self->acc;      my $acc = $self->acc;
1001    
# Line 1006  Line 1016 
1016      my $lines = [];      my $lines = [];
1017      my $line_data = [];      my $line_data = [];
1018      my $line_config = { 'title' => "PDB hit for $fid",      my $line_config = { 'title' => "PDB hit for $fid",
1019                            'hover_title' => 'PDB',
1020                          'short_title' => "best PDB",                          'short_title' => "best PDB",
1021                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1022    
1023      my $fig = new FIG;      #my $fig = new FIG;
1024      my $seq = $fig->get_translation($fid);      my $seq = $fig->get_translation($fid);
1025      my $fid_stop = length($seq);      my $fid_stop = length($seq);
1026    
# Line 1110  Line 1121 
1121    
1122    
1123  sub display_table{  sub display_table{
1124      my ($self) = @_;      my ($self,$fig) = @_;
1125    
1126      my $fig = new FIG;      #my $fig = new FIG;
1127      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1128      my $rows = $self->rows;      my $rows = $self->rows;
1129      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1174  Line 1185 
1185    
1186  sub display_table {  sub display_table {
1187    
1188      my ($self,$dataset) = @_;      my ($self,$dataset,$fig) = @_;
1189      my $fid = $self->fig_id;      my $fid = $self->fig_id;
1190      my $rows = $self->rows;      my $rows = $self->rows;
1191      my $cgi = new CGI;      my $cgi = new CGI;
# Line 1189  Line 1200 
1200          # construct the score link          # construct the score link
1201          my $score = $row->[0];          my $score = $row->[0];
1202          my $toid = $row->[1];          my $toid = $row->[1];
1203          my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";          my $link = $cgi->url(-relative => 1) . "?page=Annotation&feature=$fid";
1204          my $sc_link = "<a href=$link>$score</a>";          my $sc_link = "<a href='$link'>$score</a>";
1205    
1206          push(@$single_domain,$sc_link);          push(@$single_domain,$sc_link);
1207          push(@$single_domain,$row->[1]);          push(@$single_domain,$row->[1]);
# Line 1243  Line 1254 
1254      my $db_and_id = $thing->acc;      my $db_and_id = $thing->acc;
1255      my ($db,$id) = split("::",$db_and_id);      my ($db,$id) = split("::",$db_and_id);
1256    
1257      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
1258                                    -host     => $WebConfig::DBHOST,
1259                                    -user     => $WebConfig::DBUSER,
1260                                    -password => $WebConfig::DBPWD);
1261    
1262      my ($name_title,$name_value,$description_title,$description_value);      my ($name_title,$name_value,$description_title,$description_value);
1263      if($db eq "CDD"){      if($db eq "CDD"){
# Line 1262  Line 1276 
1276              $description_value = $cdd_obj->description;              $description_value = $cdd_obj->description;
1277          }          }
1278      }      }
1279        elsif($db =~ /PFAM/){
1280            my ($new_id) = ($id) =~ /(.*?)_/;
1281            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1282            if(!scalar(@$pfam_objs)){
1283                $name_title = "name";
1284                $name_value = "not available";
1285                $description_title = "description";
1286                $description_value = "not available";
1287            }
1288            else{
1289                my $pfam_obj = $pfam_objs->[0];
1290                $name_title = "name";
1291                $name_value = $pfam_obj->term;
1292                #$description_title = "description";
1293                #$description_value = $pfam_obj->description;
1294            }
1295        }
1296    
1297      my $line_config = { 'title' => $thing->acc,      my $short_title = $thing->acc;
1298                          'short_title' => $name_value,      $short_title =~ s/::/ - /ig;
1299        my $new_short_title=$short_title;
1300        if ($short_title =~ /interpro/){
1301            ($new_short_title) = ($short_title) =~ /(.*?)_/;
1302        }
1303        my $line_config = { 'title' => $name_value,
1304                            'hover_title', => 'Domain',
1305                            'short_title' => $new_short_title,
1306                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
1307    
1308      my $name;      my $name;
1309      $name = {"title" => $name_title,      my ($new_id) = ($id) =~ /(.*?)_/;
1310               "value" => $name_value};      $name = {"title" => $db,
1311                 "value" => $new_id};
1312      push(@$descriptions,$name);      push(@$descriptions,$name);
1313    
1314      my $description;  #    my $description;
1315      $description = {"title" => $description_title,  #    $description = {"title" => $description_title,
1316                               "value" => $description_value};  #                   "value" => $description_value};
1317      push(@$descriptions,$description);  #    push(@$descriptions,$description);
1318    
1319      my $score;      my $score;
1320      $score = {"title" => "score",      $score = {"title" => "score",
1321                "value" => $thing->evalue};                "value" => $thing->evalue};
1322      push(@$descriptions,$score);      push(@$descriptions,$score);
1323    
1324        my $location;
1325        $location = {"title" => "location",
1326                     "value" => $thing->start . " - " . $thing->stop};
1327        push(@$descriptions,$location);
1328    
1329      my $link_id;      my $link_id;
1330      if ($thing->acc =~/\w+::(\d+)/){      if ($thing->acc =~/::(.*)/){
1331          $link_id = $1;          $link_id = $1;
1332      }      }
1333    
1334      my $link;      my $link;
1335      my $link_url;      my $link_url;
1336      if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}      if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
1337      elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}      elsif($thing->class eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
1338      else{$link_url = "NO_URL"}      else{$link_url = "NO_URL"}
1339    
1340      $link = {"link_title" => $thing->acc,      $link = {"link_title" => $thing->acc,
# Line 1298  Line 1342 
1342      push(@$links_list,$link);      push(@$links_list,$link);
1343    
1344      my $element_hash = {      my $element_hash = {
1345          "title" => $thing->type,          "title" => $name_value,
1346          "start" => $thing->start,          "start" => $thing->start,
1347          "end" =>  $thing->stop,          "end" =>  $thing->stop,
1348          "color"=> $color,          "color"=> $color,
# Line 1328  Line 1372 
1372          my $db_and_id = $thing->acc;          my $db_and_id = $thing->acc;
1373          my ($db,$id) = split("::",$db_and_id);          my ($db,$id) = split("::",$db_and_id);
1374    
1375          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1376                                    -host     => $WebConfig::DBHOST,
1377                                    -user     => $WebConfig::DBUSER,
1378                                    -password => $WebConfig::DBPWD);
1379    
1380          my ($name_title,$name_value,$description_title,$description_value);          my ($name_title,$name_value,$description_title,$description_value);
1381          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1347  Line 1394 
1394                  $description_value = $cdd_obj->description;                  $description_value = $cdd_obj->description;
1395              }              }
1396          }          }
1397            elsif($db =~ /PFAM/){
1398                my ($new_id) = ($id) =~ /(.*?)_/;
1399                my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $new_id } );
1400                if(!scalar(@$pfam_objs)){
1401                    $name_title = "name";
1402                    $name_value = "not available";
1403                    $description_title = "description";
1404                    $description_value = "not available";
1405                }
1406                else{
1407                    my $pfam_obj = $pfam_objs->[0];
1408                    $name_title = "name";
1409                    $name_value = $pfam_obj->term;
1410                    #$description_title = "description";
1411                    #$description_value = $pfam_obj->description;
1412                }
1413            }
1414    
1415          my $location =  $thing->start . " - " . $thing->stop;          my $location =  $thing->start . " - " . $thing->stop;
1416    
# Line 1406  Line 1470 
1470  }  }
1471    
1472  sub display {  sub display {
1473      my ($thing,$gd) = @_;      my ($thing,$gd,$fig) = @_;
1474    
1475      my $fid = $thing->fig_id;      my $fid = $thing->fig_id;
1476      my $fig= new FIG;      #my $fig= new FIG;
1477      my $length = length($fig->get_translation($fid));      my $length = length($fig->get_translation($fid));
1478    
1479      my $cleavage_prob;      my $cleavage_prob;
# Line 1429  Line 1493 
1493      #color is      #color is
1494      my $color = "6";      my $color = "6";
1495    
1496  =pod=  =head3
1497    
1498      if($cello_location){      if($cello_location){
1499          my $cello_descriptions = [];          my $cello_descriptions = [];
# Line 1437  Line 1501 
1501    
1502          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1503                              'short_title' => 'CELLO',                              'short_title' => 'CELLO',
1504                                'hover_title' => 'Localization',
1505                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1506    
1507          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
# Line 1496  Line 1561 
1561          my $line_data =[];          my $line_data =[];
1562          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',          my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1563                              'short_title' => 'TM and SP',                              'short_title' => 'TM and SP',
1564                                'hover_title' => 'Localization',
1565                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1566    
1567          foreach my $tm_loc (@phobius_tm_locations){          foreach my $tm_loc (@phobius_tm_locations){
# Line 1549  Line 1615 
1615    
1616          my $line_config = { 'title' => 'Localization Evidence',          my $line_config = { 'title' => 'Localization Evidence',
1617                              'short_title' => 'SignalP',                              'short_title' => 'SignalP',
1618                                'hover_title' => 'Localization',
1619                              'basepair_offset' => '1' };                              'basepair_offset' => '1' };
1620    
1621          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
# Line 1669  Line 1736 
1736  =cut  =cut
1737    
1738  sub display {  sub display {
1739      my ($self,$gd) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
1740    
1741      my $fig = new FIG;      # declare variables
1742      my $peg = $self->acc;      my $window_size = $gd->window_size;
1743      my $query = $self->query;      my $peg = $thing->acc;
1744        my $query_id = $thing->query;
1745      my $organism = $self->organism;      my $organism = $thing->organism;
1746        my $abbrev_name = $fig->abbrev($organism);
1747        if (!$organism){
1748          $organism = $peg;
1749          $abbrev_name = $peg;
1750        }
1751      my $genome = $fig->genome_of($peg);      my $genome = $fig->genome_of($peg);
1752      my ($org_tax) = ($genome) =~ /(.*)\./;      my ($org_tax) = ($genome) =~ /(.*)\./;
1753      my $function = $self->function;      my $function = $thing->function;
1754      my $abbrev_name = $fig->abbrev($organism);      my $query_start = $thing->qstart;
1755      my $align_start = $self->qstart;      my $query_stop = $thing->qstop;
1756      my $align_stop = $self->qstop;      my $hit_start = $thing->hstart;
1757      my $hit_start = $self->hstart;      my $hit_stop = $thing->hstop;
1758      my $hit_stop = $self->hstop;      my $ln_query = $thing->qlength;
1759        my $ln_hit = $thing->hlength;
1760        my $query_color = match_color($query_start, $query_stop, $ln_query, 1);
1761        my $hit_color = match_color($hit_start, $hit_stop, $ln_hit, 1);
1762    
1763      my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;      my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1764    
1765        # hit sequence title
1766      my $line_config = { 'title' => "$organism [$org_tax]",      my $line_config = { 'title' => "$organism [$org_tax]",
1767                          'short_title' => "$abbrev_name",                          'short_title' => "$abbrev_name",
1768                          'title_link' => '$tax_link',                          'title_link' => '$tax_link',
1769                          'basepair_offset' => '0'                          'basepair_offset' => '0'
1770                          };                          };
1771    
1772        # query sequence title
1773        my $replace_id = $peg;
1774        $replace_id =~ s/\|/_/ig;
1775        my $anchor_name = "anchor_". $replace_id;
1776        my $query_config = { 'title' => "Query",
1777                             'short_title' => "Query",
1778                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1779                             'basepair_offset' => '0'
1780                             };
1781      my $line_data = [];      my $line_data = [];
1782        my $query_data = [];
1783    
1784      my $element_hash;      my $element_hash;
1785      my $links_list = [];      my $hit_links_list = [];
1786      my $descriptions = [];      my $hit_descriptions = [];
1787        my $query_descriptions = [];
1788      # get subsystem information  
1789      my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;      # get sequence information
1790        # evidence link
1791      my $link;      my $evidence_link;
1792      $link = {"link_title" => $peg,      if ($peg =~ /^fig\|/){
1793               "link" => $url_link};        $evidence_link = "?page=Evidence&feature=".$peg;
1794      push(@$links_list,$link);      }
1795        else{
1796          my $db = &Observation::get_database($peg);
1797          my ($link_id) = ($peg) =~ /\|(.*)/;
1798          $evidence_link = &HTML::alias_url($link_id, $db);
1799          #print STDERR "LINK: $db    $evidence_link";
1800        }
1801        my $link = {"link_title" => $peg,
1802                    "link" => $evidence_link};
1803        push(@$hit_links_list,$link) if ($evidence_link);
1804    
1805      my @subsystems = $fig->peg_to_subsystems($peg);      # subsystem link
1806      foreach my $subsystem (@subsystems){      my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1807          my $link;      my @subsystems;
1808          $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",      foreach my $array (@$subs){
1809            my $subsystem = $$array[0];
1810            push(@subsystems,$subsystem);
1811            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1812                   "link_title" => $subsystem};                   "link_title" => $subsystem};
1813          push(@$links_list,$link);          push(@$hit_links_list,$link);
1814      }      }
1815    
1816      $link = {"link_title" => "blast against query",      # blast alignment
1817               "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=tool_result&tool=bl2seq&peg1=$query&peg2=$peg"};      $link = {"link_title" => "view blast alignment",
1818      push (@$links_list,$link);               "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1819        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1820    
1821        # description data
1822      my $description_function;      my $description_function;
1823      $description_function = {"title" => "function",      $description_function = {"title" => "function",
1824                               "value" => $function};                               "value" => $function};
1825      push(@$descriptions,$description_function);      push(@$hit_descriptions,$description_function);
1826    
1827      my ($description_ss, $ss_string);      # subsystem description
1828      $ss_string = join (",", @subsystems);      my $ss_string = join (",", @subsystems);
1829      $description_ss = {"title" => "subsystems",      $ss_string =~ s/_/ /ig;
1830        my $description_ss = {"title" => "subsystems",
1831                         "value" => $ss_string};                         "value" => $ss_string};
1832      push(@$descriptions,$description_ss);      push(@$hit_descriptions,$description_ss);
1833    
1834        # location description
1835        # hit
1836      my $description_loc;      my $description_loc;
1837      $description_loc = {"title" => "location start",      $description_loc = {"title" => "Hit Location",
1838                          "value" => $hit_start};                          "value" => $hit_start . " - " . $hit_stop};
1839      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1840    
1841      $description_loc = {"title" => "location stop",      $description_loc = {"title" => "Sequence Length",
1842                          "value" => $hit_stop};                          "value" => $ln_hit};
1843      push(@$descriptions, $description_loc);      push(@$hit_descriptions, $description_loc);
1844    
1845        # query
1846        $description_loc = {"title" => "Hit Location",
1847                            "value" => $query_start . " - " . $query_stop};
1848        push(@$query_descriptions, $description_loc);
1849    
1850        $description_loc = {"title" => "Sequence Length",
1851                            "value" => $ln_query};
1852        push(@$query_descriptions, $description_loc);
1853    
1854    
1855      my $evalue = $self->evalue;  
1856        # evalue score description
1857        my $evalue = $thing->evalue;
1858      while ($evalue =~ /-0/)      while ($evalue =~ /-0/)
1859      {      {
1860          my ($chunk1, $chunk2) = split(/-/, $evalue);          my ($chunk1, $chunk2) = split(/-/, $evalue);
# Line 1748  Line 1863 
1863      }      }
1864    
1865      my $color = &color($evalue);      my $color = &color($evalue);
   
1866      my $description_eval = {"title" => "E-Value",      my $description_eval = {"title" => "E-Value",
1867                              "value" => $evalue};                              "value" => $evalue};
1868      push(@$descriptions, $description_eval);      push(@$hit_descriptions, $description_eval);
1869        push(@$query_descriptions, $description_eval);
1870    
1871      my $identity = $self->identity;      my $identity = $self->identity;
1872      my $description_identity = {"title" => "Identity",      my $description_identity = {"title" => "Identity",
1873                                  "value" => $identity};                                  "value" => $identity};
1874      push(@$descriptions, $description_identity);      push(@$hit_descriptions, $description_identity);
1875        push(@$query_descriptions, $description_identity);
1876    
1877    
1878        my $number = $base_start + ($query_start-$hit_start);
1879        #print STDERR "START: $number";
1880        $element_hash = {
1881            "title" => $query_id,
1882            "start" => $base_start,
1883            "end" => $base_start+$ln_query,
1884            "type"=> 'box',
1885            "color"=> $color,
1886            "zlayer" => "2",
1887            "links_list" => $query_links_list,
1888            "description" => $query_descriptions
1889            };
1890        push(@$query_data,$element_hash);
1891    
1892        $element_hash = {
1893            "title" => $query_id . ': HIT AREA',
1894            "start" => $base_start + $query_start,
1895            "end" =>  $base_start + $query_stop,
1896            "type"=> 'smallbox',
1897            "color"=> $query_color,
1898            "zlayer" => "3",
1899            "links_list" => $query_links_list,
1900            "description" => $query_descriptions
1901            };
1902        push(@$query_data,$element_hash);
1903    
1904        $gd->add_line($query_data, $query_config);
1905    
1906    
1907      $element_hash = {      $element_hash = {
1908          "title" => $peg,          "title" => $peg,
1909          "start" => $align_start,                  "start" => $base_start + ($query_start-$hit_start),
1910          "end" =>  $align_stop,                  "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1911          "type"=> 'box',          "type"=> 'box',
1912          "color"=> $color,          "color"=> $color,
1913          "zlayer" => "2",          "zlayer" => "2",
1914          "links_list" => $links_list,                  "links_list" => $hit_links_list,
1915          "description" => $descriptions                  "description" => $hit_descriptions
1916                    };
1917        push(@$line_data,$element_hash);
1918    
1919        $element_hash = {
1920            "title" => $peg . ': HIT AREA',
1921            "start" => $base_start + $query_start,
1922            "end" =>  $base_start + $query_stop,
1923            "type"=> 'smallbox',
1924            "color"=> $hit_color,
1925            "zlayer" => "3",
1926            "links_list" => $hit_links_list,
1927            "description" => $hit_descriptions
1928          };          };
1929      push(@$line_data,$element_hash);      push(@$line_data,$element_hash);
1930    
1931      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1932    
1933      return ($gd);      my $breaker = [];
1934        my $breaker_hash = {};
1935        my $breaker_config = { 'no_middle_line' => "1" };
1936    
1937        push (@$breaker, $breaker_hash);
1938        $gd->add_line($breaker, $breaker_config);
1939    
1940        return ($gd);
1941  }  }
1942    
1943  =head3 display_domain_composition()  =head3 display_domain_composition()
# Line 1782  Line 1947 
1947  =cut  =cut
1948    
1949  sub display_domain_composition {  sub display_domain_composition {
1950      my ($self,$gd) = @_;      my ($self,$gd,$fig) = @_;
1951    
1952      my $fig = new FIG;      #$fig = new FIG;
1953      my $peg = $self->acc;      my $peg = $self->acc;
1954    
1955      my $line_data = [];      my $line_data = [];
# Line 1792  Line 1957 
1957      my $descriptions = [];      my $descriptions = [];
1958    
1959      my @domain_query_results =$fig->get_attributes($peg,"CDD");      my @domain_query_results =$fig->get_attributes($peg,"CDD");
1960        #my @domain_query_results = ();
1961      foreach $dqr (@domain_query_results){      foreach $dqr (@domain_query_results){
1962          my $key = @$dqr[1];          my $key = @$dqr[1];
1963          my @parts = split("::",$key);          my @parts = split("::",$key);
# Line 1817  Line 1982 
1982              }              }
1983          }          }
1984    
1985          my $dbmaster = DBMaster->new(-database =>'Ontology');          my $dbmaster = DBMaster->new(-database =>'Ontology',
1986                                    -host     => $WebConfig::DBHOST,
1987                                    -user     => $WebConfig::DBUSER,
1988                                    -password => $WebConfig::DBPWD);
1989          my ($name_value,$description_value);          my ($name_value,$description_value);
1990    
1991          if($db eq "CDD"){          if($db eq "CDD"){
# Line 1854  Line 2022 
2022          my $link;          my $link;
2023          my $link_url;          my $link_url;
2024          if ($db eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}          if ($db eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"}
2025          elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}          elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
2026          else{$link_url = "NO_URL"}          else{$link_url = "NO_URL"}
2027    
2028          $link = {"link_title" => $name_value,          $link = {"link_title" => $name_value,
# Line 1878  Line 2046 
2046      }      }
2047    
2048      my $line_config = { 'title' => $peg,      my $line_config = { 'title' => $peg,
2049                            'hover_title' => 'Domain',
2050                          'short_title' => $peg,                          'short_title' => $peg,
2051                          'basepair_offset' => '1' };                          'basepair_offset' => '1' };
2052    
# Line 1897  Line 2066 
2066  =cut  =cut
2067    
2068  sub display_table {  sub display_table {
2069      my ($self,$dataset, $scroll_list, $query_fid,$lineages) = @_;      my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
2070    
2071      my $data = [];      my $data = [];
2072      my $count = 0;      my $count = 0;
2073      my $content;      my $content;
     my $fig = new FIG;  
2074      my $cgi = new CGI;      my $cgi = new CGI;
2075      my @ids;      my @ids;
2076        $lineages = $fig->taxonomy_list();
2077    
2078      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2079          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2080          push (@ids, $thing->acc);          push (@ids, $thing->acc);
2081      }      }
2082    
2083      my (%box_column, %subsystems_column, %evidence_column, %e_identical);      my (%box_column, %subsystems_column, %evidence_column, %e_identical, $function_color);
2084        my @attributes = $fig->get_attributes(\@ids);
2085    
2086      # get the column for the subsystems      # get the column for the subsystems
2087      %subsystems_column = &get_subsystems_column(\@ids);      %subsystems_column = &get_subsystems_column(\@ids,$fig);
2088    
2089      # get the column for the evidence codes      # get the column for the evidence codes
2090      %evidence_column = &get_evidence_column(\@ids);      %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
2091    
2092      # get the column for pfam_domain      # get the column for pfam_domain
2093      %pfam_column = &get_pfam_column(\@ids);      %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
2094    
2095        # get the colors for the function cell
2096        my $functions = $fig->function_of_bulk(\@ids,1);
2097        $function_color = &get_function_color_cell($functions, $fig);
2098        my $query_function = $fig->function_of($query_fid);
2099    
2100      my %e_identical = &get_essentially_identical($query_fid);      %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2101      my $all_aliases = $fig->feature_aliases_bulk(\@ids);      my $alias_col = &get_aliases(\@ids,$fig);
2102        #my $alias_col = {};
2103    
2104        my $figfam_data = &FIG::get_figfams_data();
2105        my $figfams = new FFs($figfam_data);
2106    
2107        my $func_color_offset=0;
2108      foreach my $thing (@$dataset) {      foreach my $thing (@$dataset) {
2109          next if ($thing->class ne "SIM");          next if ($thing->class ne "SIM");
2110          my $single_domain = [];          my $single_domain = [];
2111          $count++;          $count++;
2112    
2113          my $id = $thing->acc;          my $id = $thing->acc;
2114            my $taxid   = $fig->genome_of($id);
2115          my $iden    = $thing->identity;          my $iden    = $thing->identity;
2116          my $ln1     = $thing->qlength;          my $ln1     = $thing->qlength;
2117          my $ln2     = $thing->hlength;          my $ln2     = $thing->hlength;
# Line 1940  Line 2121 
2121          my $e2      = $thing->hstop;          my $e2      = $thing->hstop;
2122          my $d1      = abs($e1 - $b1) + 1;          my $d1      = abs($e1 - $b1) + 1;
2123          my $d2      = abs($e2 - $b2) + 1;          my $d2      = abs($e2 - $b2) + 1;
2124          my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";          my $color1  = match_color( $b1, $e1, $ln1 );
2125          my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";          my $color2  = match_color( $b2, $e2, $ln2 );
2126            my $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2127            my $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2128    
2129            # organisms cell
2130            my ($org, $org_color) = $fig->org_and_color_of($id);
2131            my $org_cell = { 'data' =>  $thing->organism, 'highlight' => $org_color};
2132    
2133          # checkbox column          # checkbox cell
2134            my ($box_cell,$tax);
2135          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2136          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2137          my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_". $id;
2138          my ($tax) = ($id) =~ /fig\|(.*?)\./;          my $replace_id = $id;
2139            $replace_id =~ s/\|/_/ig;
2140            my $anchor_name = "anchor_". $replace_id;
2141            if ($id =~ /^fig\|/){
2142              my $box = qq(<a name="$anchor_name"></a><input type="checkbox" name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name','$cell_name');">);
2143              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2144              ($tax) = ($id) =~ /fig\|(.*?)\./;
2145            }
2146            else{
2147              my $box = qq(<a name="$anchor_name"></a>);
2148              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2149            }
2150    
2151          # get the linked fig id          # get the linked fig id
2152          my $fig_col;          my $anchor_link = "graph_" . $replace_id;
2153          if (defined ($e_identical{$id})){          my $fig_data =  "<table><tr><td>" . &HTML::set_prot_links($cgi,$id) . "</td>" . "&nbsp;" x 2;
2154              $fig_col = &HTML::set_prot_links($cgi,$id) . "*";          $fig_data .= qq(<td><img height='10px' width='20px' src='./Html/anchor_alignment.png' alt='View Graphic View of Alignment' onClick='changeSimsLocation("$anchor_link", 0)'/></td></tr></table>);
2155          }          my $fig_col = {'data'=> $fig_data,
2156          else{                         'highlight'=>"#ffffff"};
2157              $fig_col = &HTML::set_prot_links($cgi,$id);  
2158          }      $replace_id = $peg;
2159        $replace_id =~ s/\|/_/ig;
2160          push(@$single_domain,$box_col);                        # permanent column      $anchor_name = "anchor_". $replace_id;
2161          push(@$single_domain,$fig_col);                        # permanent column      my $query_config = { 'title' => "Query",
2162          push(@$single_domain,$thing->evalue);                  # permanent column                           'short_title' => "Query",
2163          push(@$single_domain,"$iden\%");                       # permanent column                           'title_link' => "changeSimsLocation('$replace_id')",
2164          push(@$single_domain,$reg1);                           # permanent column                           'basepair_offset' => '0'
2165          push(@$single_domain,$reg2);                           # permanent column                           };
2166          push(@$single_domain,$thing->organism);                # permanent column          # function cell
2167          push(@$single_domain,$thing->function);                # permanent column          my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2168                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2169                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2170            my $current_function =  $thing->function;
2171            my $function_color = $function_cell_colors->{ $function_color->{$current_function} - $func_color_offset};
2172            my $function_cell;
2173            if ($current_function){
2174              if ($current_function eq $query_function){
2175                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2176                $func_color_offset=1;
2177              }
2178              else{
2179                $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2180              }
2181            }
2182            else{
2183              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2184            }
2185    
2186            push (@$single_domain, $box_cell, $fig_col, {'data'=> $thing->evalue, 'highlight'=>"#ffffff"},
2187                   {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);   # permanent columns
2188    
2189            my ($ff) = $figfams->families_containing_peg($id);
2190    
2191          foreach my $col (sort keys %$scroll_list){          foreach my $col (sort keys %$scroll_list){
2192              if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}              if ($col =~ /associated_subsystem/)          {push(@$single_domain,{'data'=>$subsystems_column{$id},'highlight'=>"#ffffff"});}
2193              elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}              elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column{$id},'highlight'=>"#ffffff"});}
2194              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}              elsif ($col =~ /pfam_domains/)               {push(@$single_domain,{'data'=>$pfam_column{$id},'highlight'=>"#ffffff"});}
2195              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'NCBI', $all_aliases));}              elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>"#ffffff"});}
2196              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'RefSeq', $all_aliases));}              elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>"#ffffff"});}
2197              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,&get_prefer($thing->acc, 'SwissProt', $all_aliases));}              elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>"#ffffff"});}
2198              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,&get_prefer($thing->acc, 'UniProt', $all_aliases));}              elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>"#ffffff"});}
2199              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'TIGR', $all_aliases));}              elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>"#ffffff"});}
2200              elsif ($col =~ /pir_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'PIR', $all_aliases));}              elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>"#ffffff"});}
2201              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'KEGG', $all_aliases));}              elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>"#ffffff"});}
2202              elsif ($col =~ /trembl_id/)                  {push(@$single_domain,&get_prefer($thing->acc, 'TrEMBL', $all_aliases));}              #elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>"#ffffff"});}
2203              elsif ($col =~ /asap_id/)                    {push(@$single_domain,&get_prefer($thing->acc, 'ASAP', $all_aliases));}              elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>"#ffffff"});}
2204              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,&get_prefer($thing->acc, 'JGI', $all_aliases));}              elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>"#ffffff"});}
2205              elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}              elsif ($col =~ /taxonomy/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>"#ffffff"});}
2206                #elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$fig->taxonomy_of($taxid));}
2207                #elsif ($col =~ /figfam/)                     {push(@$single_domain,"<a href='?page=FigFamViewer&figfam=" . $ff_hash->{$id} . "' target='_new'>" . $ff_hash->{$id} . "</a>");}
2208                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>"#ffffff"});}
2209          }          }
2210          push(@$data,$single_domain);          push(@$data,$single_domain);
2211      }      }
   
2212      if ($count >0 ){      if ($count >0 ){
2213          $content = $data;          $content = $data;
2214      }      }
# Line 2000  Line 2224 
2224      foreach my $id (@$ids){      foreach my $id (@$ids){
2225          my $field_name = "tables_" . $id;          my $field_name = "tables_" . $id;
2226          my $pair_name = "visual_" . $id;          my $pair_name = "visual_" . $id;
2227          $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);          my $cell_name = "cell_" . $id;
2228            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2229      }      }
2230      return (%column);      return (%column);
2231  }  }
2232    
2233  sub get_subsystems_column{  sub get_subsystems_column{
2234      my ($ids) = @_;      my ($ids,$fig) = @_;
2235    
2236      my $fig = new FIG;      #my $fig = new FIG;
2237      my $cgi = new CGI;      my $cgi = new CGI;
2238      my %in_subs  = $fig->subsystems_for_pegs($ids);      my %in_subs  = $fig->subsystems_for_pegs($ids);
2239      my %column;      my %column;
# Line 2017  Line 2242 
2242          my @subsystems;          my @subsystems;
2243    
2244          if (@in_sub > 0) {          if (@in_sub > 0) {
             my $count = 1;  
2245              foreach my $array(@in_sub){              foreach my $array(@in_sub){
2246                  push (@subsystems, $count . ". " . $$array[0]);                  my $ss = $$array[0];
2247                  $count++;                  $ss =~ s/_/ /ig;
2248                    push (@subsystems, "-" . $ss);
2249              }              }
2250              my $in_sub_line = join ("<br>", @subsystems);              my $in_sub_line = join ("<br>", @subsystems);
2251              $column{$id} = $in_sub_line;              $column{$id} = $in_sub_line;
# Line 2031  Line 2256 
2256      return (%column);      return (%column);
2257  }  }
2258    
2259    sub match_color {
2260        my ( $b, $e, $n , $rgb) = @_;
2261        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2262        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2263        my $cov = ( $r - $l + 1 ) / $n;
2264        my $sat = 1 - 10 * $cov / 9;
2265        my $br  = 1;
2266        if ($rgb){
2267            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2268        }
2269        else{
2270            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2271        }
2272    }
2273    
2274    sub hsb2rgb {
2275        my ( $h, $s, $br ) = @_;
2276        $h = 6 * ($h - floor($h));
2277        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2278        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2279        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2280                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2281                                          :               ( 0,      1,      $h - 2 )
2282                                          )
2283                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2284                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2285                                          :               ( 1,      0,      6 - $h )
2286                                          );
2287        ( ( $r * $s + 1 - $s ) * $br,
2288          ( $g * $s + 1 - $s ) * $br,
2289          ( $b * $s + 1 - $s ) * $br
2290        )
2291    }
2292    
2293    sub html2rgb {
2294        my ($hex) = @_;
2295        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2296        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2297                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2298    
2299        my @R = split(//, $r);
2300        my @G = split(//, $g);
2301        my @B = split(//, $b);
2302    
2303        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2304        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2305        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2306    
2307        my $rgb = [$red, $green, $blue];
2308        return $rgb;
2309    
2310    }
2311    
2312    sub rgb2html {
2313        my ( $r, $g, $b ) = @_;
2314        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2315        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2316        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2317        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2318    }
2319    
2320    sub floor {
2321        my $x = $_[0];
2322        defined( $x ) || return undef;
2323        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2324    }
2325    
2326    sub get_function_color_cell{
2327      my ($functions, $fig) = @_;
2328    
2329      # figure out the quantity of each function
2330      my %hash;
2331      foreach my $key (keys %$functions){
2332        my $func = $functions->{$key};
2333        $hash{$func}++;
2334      }
2335    
2336      my %func_colors;
2337      my $count = 1;
2338      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2339        $func_colors{$key}=$count;
2340        $count++;
2341      }
2342    
2343      return \%func_colors;
2344    }
2345    
2346  sub get_essentially_identical{  sub get_essentially_identical{
2347      my ($fid) = @_;      my ($fid,$dataset,$fig) = @_;
2348      my $fig = new FIG;      #my $fig = new FIG;
2349    
2350      my %id_list;      my %id_list;
2351      my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);      #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2352    
2353      foreach my $id (@maps_to) {      foreach my $thing (@$dataset){
2354            if($thing->class eq "IDENTICAL"){
2355                my $rows = $thing->rows;
2356                my $count_identical = 0;
2357                foreach my $row (@$rows) {
2358                    my $id = $row->[0];
2359          if (($id ne $fid) && ($fig->function_of($id))) {          if (($id ne $fid) && ($fig->function_of($id))) {
2360              $id_list{$id} = 1;              $id_list{$id} = 1;
2361          }          }
2362      }      }
2363            }
2364        }
2365    
2366    #    foreach my $id (@maps_to) {
2367    #        if (($id ne $fid) && ($fig->function_of($id))) {
2368    #           $id_list{$id} = 1;
2369    #        }
2370    #    }
2371      return(%id_list);      return(%id_list);
2372  }  }
2373    
2374    
2375  sub get_evidence_column{  sub get_evidence_column{
2376      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2377      my $fig = new FIG;      #my $fig = new FIG;
2378      my $cgi = new CGI;      my $cgi = new CGI;
2379      my (%column, %code_attributes);      my (%column, %code_attributes);
2380    
2381      my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2382      foreach my $key (@codes){      foreach my $key (@codes){
2383          push (@{$code_attributes{$$key[0]}}, $key);          push (@{$code_attributes{$$key[0]}}, $key);
2384      }      }
# Line 2061  Line 2386 
2386      foreach my $id (@$ids){      foreach my $id (@$ids){
2387          # add evidence code with tool tip          # add evidence code with tool tip
2388          my $ev_codes=" &nbsp; ";          my $ev_codes=" &nbsp; ";
         my @ev_codes = "";  
2389    
2390          if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {          my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2391              my @codes;          my @ev_codes = ();
             @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});  
             @ev_codes = ();  
2392              foreach my $code (@codes) {              foreach my $code (@codes) {
2393                  my $pretty_code = $code->[2];                  my $pretty_code = $code->[2];
2394                  if ($pretty_code =~ /;/) {                  if ($pretty_code =~ /;/) {
# Line 2076  Line 2398 
2398                  }                  }
2399                  push(@ev_codes, $pretty_code);                  push(@ev_codes, $pretty_code);
2400              }              }
         }  
2401    
2402          if (scalar(@ev_codes) && $ev_codes[0]) {          if (scalar(@ev_codes) && $ev_codes[0]) {
2403              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
# Line 2090  Line 2411 
2411  }  }
2412    
2413  sub get_pfam_column{  sub get_pfam_column{
2414      my ($ids) = @_;      my ($ids, $attributes,$fig) = @_;
2415      my $fig = new FIG;      #my $fig = new FIG;
2416      my $cgi = new CGI;      my $cgi = new CGI;
2417      my (%column, %code_attributes, %attribute_locations);      my (%column, %code_attributes, %attribute_locations);
2418      my $dbmaster = DBMaster->new(-database =>'Ontology');      my $dbmaster = DBMaster->new(-database =>'Ontology',
2419                                    -host     => $WebConfig::DBHOST,
2420                                    -user     => $WebConfig::DBUSER,
2421                                    -password => $WebConfig::DBPWD);
2422    
2423      my @codes = grep { $_->[1] =~ /^PFAM/i } $fig->get_attributes($ids);      my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2424      foreach my $key (@codes){      foreach my $key (@codes){
2425          push (@{$code_attributes{$$key[0]}}, $$key[1]);          my $name = $key->[1];
2426          push (@{$attribute_location{$$key[0]}{$$key[1]}}, $$key[2]);          if ($name =~ /_/){
2427                ($name) = ($key->[1]) =~ /(.*?)_/;
2428            }
2429            push (@{$code_attributes{$key->[0]}}, $name);
2430            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2431      }      }
2432    
2433      foreach my $id (@$ids){      foreach my $id (@$ids){
2434          # add evidence code with tool tip          # add evidence code
2435          my $pfam_codes=" &nbsp; ";          my $pfam_codes=" &nbsp; ";
2436          my @pfam_codes = "";          my @pfam_codes = "";
2437          my %description_codes;          my %description_codes;
# Line 2119  Line 2447 
2447    
2448              foreach my $code (@ncodes) {              foreach my $code (@ncodes) {
2449                  my @parts = split("::",$code);                  my @parts = split("::",$code);
2450                  my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";                  my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2451    
2452                  # get the locations for the domain                  # get the locations for the domain
2453                  my @locs;                  my @locs;
# Line 2127  Line 2455 
2455                      my ($loc) = ($part) =~ /\;(.*)/;                      my ($loc) = ($part) =~ /\;(.*)/;
2456                      push (@locs,$loc);                      push (@locs,$loc);
2457                  }                  }
2458                    my %locsaw;
2459                    foreach my $key (@locs) {$locsaw{$key}=1;}
2460                    @locs = keys %locsaw;
2461    
2462                  my $locations = join (", ", @locs);                  my $locations = join (", ", @locs);
2463    
2464                  if (defined ($description_codes{$parts[1]})){                  if (defined ($description_codes{$parts[1]})){
# Line 2146  Line 2478 
2478    
2479  }  }
2480    
2481  sub get_prefer {  sub get_aliases {
2482      my ($fid, $db, $all_aliases) = @_;      my ($ids,$fig) = @_;
     my $fig = new FIG;  
     my $cgi = new CGI;  
2483    
2484      foreach my $alias (@{$$all_aliases{$fid}}){      my $all_aliases = $fig->feature_aliases_bulk($ids);
2485        foreach my $id (@$ids){
2486            foreach my $alias (@{$$all_aliases{$id}}){
2487          my $id_db = &Observation::get_database($alias);          my $id_db = &Observation::get_database($alias);
2488          if ($id_db eq $db){              next if ($aliases->{$id}->{$id_db});
2489              my $acc_col .= &HTML::set_prot_links($cgi,$alias);              $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
             return ($acc_col);  
2490          }          }
2491      }      }
2492      return (" ");      return ($aliases);
2493  }  }
2494    
2495  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2496    
2497  sub color {  sub color {
2498      my ($evalue) = @_;      my ($evalue) = @_;
2499        my $palette = WebColors::get_palette('vitamins');
2500      my $color;      my $color;
2501      if ($evalue <= 1e-170){        $color = 51;    }      if ($evalue <= 1e-170){        $color = $palette->[0];    }
2502      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }      elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2503      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }      elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2504      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }      elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2505      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }      elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2506      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }      elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2507      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }      elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2508      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }      elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2509      elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }      elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2510      else{        $color = 60;    }      else{        $color = $palette->[9];    }
2511      return ($color);      return ($color);
2512  }  }
2513    
# Line 2195  Line 2527 
2527  }  }
2528    
2529  sub display {  sub display {
2530      my ($self,$gd,$selected_taxonomies,$taxes) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2531    
2532        $taxes = $fig->taxonomy_list();
2533    
2534      my $fid = $self->fig_id;      my $fid = $self->fig_id;
2535      my $compare_or_coupling = $self->context;      my $compare_or_coupling = $self->context;
2536      my $gd_window_size = $gd->window_size;      my $gd_window_size = $gd->window_size;
2537      my $fig = new FIG;      my $range = $gd_window_size;
2538      my $all_regions = [];      my $all_regions = [];
2539      my $gene_associations={};      my $gene_associations={};
2540    
# Line 2225  Line 2559 
2559      my ($region_start, $region_end);      my ($region_start, $region_end);
2560      if ($beg < $end)      if ($beg < $end)
2561      {      {
2562          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2563          $region_end = $end+4000;          $region_end = $end+ ($range);
2564          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);          $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2565      }      }
2566      else      else
2567      {      {
2568          $region_start = $end-4000;          $region_start = $end-($range);
2569          $region_end = $beg+4000;          $region_end = $beg+($range);
2570          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);          $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2571          $reverse_flag{$target_genome} = $fid;          $reverse_flag{$target_genome} = $fid;
2572          $gene_associations->{$fid}->{"reverse_flag"} = 1;          $gene_associations->{$fid}->{"reverse_flag"} = 1;
# Line 2240  Line 2574 
2574    
2575      # call genes in region      # call genes in region
2576      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);      my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2577        #foreach my $feat (@$target_gene_features){
2578        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2579        #}
2580      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2581      my (@start_array_region);      my (@start_array_region);
2582      push (@start_array_region, $offset);      push (@start_array_region, $offset);
2583    
2584      my %all_genes;      my %all_genes;
2585      my %all_genomes;      my %all_genomes;
2586      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}      foreach my $feature (@$target_gene_features){
2587            #if ($feature =~ /peg/){
2588                $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2589            #}
2590        }
2591    
2592        my @selected_sims;
2593    
2594      if ($compare_or_coupling eq "sims"){      if ($compare_or_coupling eq "sims"){
2595          # get the selected boxes          # get the selected boxes
2596          my @selected_taxonomy = @$selected_taxonomies;          my @selected_taxonomy = @$selected_taxonomies;
2597    
2598          # get the similarities and store only the ones that match the lineages selected          # get the similarities and store only the ones that match the lineages selected
         my @selected_sims;  
         my @sims= $fig->nsims($fid,20000,10,"fig");  
   
2599          if (@selected_taxonomy > 0){          if (@selected_taxonomy > 0){
2600              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2601                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2602                  my $genome = $fig->genome_of($sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2603                  my ($genome1) = ($genome) =~ /(.*)\./;  
2604                  my $lineage = $taxes->{$genome1};                  #my $genome = $fig->genome_of($sim->[1]);
2605                  #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));                  my $genome = $fig->genome_of($sim->acc);
2606                    #my ($genome1) = ($genome) =~ /(.*)\./;
2607                    my $lineage = $taxes->{$genome};
2608                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2609                  foreach my $taxon(@selected_taxonomy){                  foreach my $taxon(@selected_taxonomy){
2610                      if ($lineage =~ /$taxon/){                      if ($lineage =~ /$taxon/){
2611                          push (@selected_sims, $sim->[1]);                          #push (@selected_sims, $sim->[1]);
2612                            push (@selected_sims, $sim->acc);
2613                      }                      }
2614                  }                  }
                 my %saw;  
                 @selected_sims = grep(!$saw{$_}++, @selected_sims);  
2615              }              }
2616          }          }
2617          else{          else{
2618              my $simcount = 0;              my $simcount = 0;
2619              foreach my $sim (@sims){              foreach my $sim (@$sims_array){
2620                  next if ($sim->[1] !~ /fig\|/);                  next if ($sim->class ne "SIM");
2621                  push (@selected_sims, $sim->[1]);                  next if ($sim->acc !~ /fig\|/);
2622    
2623                    push (@selected_sims, $sim->acc);
2624                  $simcount++;                  $simcount++;
2625                  last if ($simcount > 4);                  last if ($simcount > 4);
2626              }              }
2627          }          }
2628    
2629            my %saw;
2630            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2631    
2632          # get the gene context for the sorted matches          # get the gene context for the sorted matches
2633          foreach my $sim_fid(@selected_sims){          foreach my $sim_fid(@selected_sims){
2634              #get the organism genome              #get the organism genome
# Line 2304  Line 2651 
2651              my ($region_start, $region_end);              my ($region_start, $region_end);
2652              if ($beg < $end)              if ($beg < $end)
2653              {              {
2654                  $region_start = $beg - 4000;                  $region_start = $beg - ($range/2);
2655                  $region_end = $end+4000;                  $region_end = $end+($range/2);
2656                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);                  $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2657              }              }
2658              else              else
2659              {              {
2660                  $region_start = $end-4000;                  $region_start = $end-($range/2);
2661                  $region_end = $beg+4000;                  $region_end = $beg+($range/2);
2662                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);                  $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2663                  $reverse_flag{$sim_genome} = $sim_fid;                  $reverse_flag{$sim_genome} = $sim_fid;
2664                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;                  $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
# Line 2327  Line 2674 
2674    
2675      }      }
2676    
2677        #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2678      # cluster the genes      # cluster the genes
2679      my @all_pegs = keys %all_genes;      my @all_pegs = keys %all_genes;
2680      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);      my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2681        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2682        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2683    
2684      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2685          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2686          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2687          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2688          my $abbrev_name = $fig->abbrev($region_gs);          my $abbrev_name = $fig->abbrev($region_gs);
2689          my ($genome1) = ($region_genome) =~ /(.*?)\./;          #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2690          my $lineage = $taxes->{$genome1};          my $lineage = $taxes->{$region_genome};
2691            #my $lineage = $fig->taxonomy_of($region_genome);
2692          #$region_gs .= "Lineage:$lineage";          #$region_gs .= "Lineage:$lineage";
2693          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2694                              'short_title' => $abbrev_name,                              'short_title' => $abbrev_name,
# Line 2370  Line 2721 
2721    
2722              # get subsystem information              # get subsystem information
2723              my $function = $fig->function_of($fid1);              my $function = $fig->function_of($fid1);
2724              my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;              my $url_link = "?page=Annotation&feature=".$fid1;
2725    
2726              my $link;              my $link;
2727              $link = {"link_title" => $fid1,              $link = {"link_title" => $fid1,
2728                       "link" => $url_link};                       "link" => $url_link};
2729              push(@$links_list,$link);              push(@$links_list,$link);
2730    
2731              my @subsystems = $fig->peg_to_subsystems($fid1);              my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2732              foreach my $subsystem (@subsystems){              my @subsystems;
2733                foreach my $array (@subs){
2734                    my $subsystem = $$array[0];
2735                    my $ss = $subsystem;
2736                    $ss =~ s/_/ /ig;
2737                    push (@subsystems, $ss);
2738                    my $link;
2739                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
2740                             "link_title" => $ss};
2741                    push(@$links_list,$link);
2742                }
2743    
2744                if ($fid1 eq $fid){
2745                  my $link;                  my $link;
2746                  $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",                  $link = {"link_title" => "Annotate this sequence",
2747                           "link_title" => $subsystem};                           "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2748                  push(@$links_list,$link);                  push(@$links_list,$link);
2749              }              }
2750    
# Line 2415  Line 2778 
2778                  $prev_stop = $stop;                  $prev_stop = $stop;
2779                  $prev_fig = $fid1;                  $prev_fig = $fid1;
2780    
2781                  if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){                  if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_gnes{$fid1})){
2782                      $start = $gd_window_size - $start;                      $start = $gd_window_size - $start;
2783                      $stop = $gd_window_size - $stop;                      $stop = $gd_window_size - $stop;
2784                  }                  }
2785    
2786                    my $title = $fid1;
2787                    if ($fid1 eq $fid){
2788                        $title = "My query gene: $fid1";
2789                    }
2790    
2791                  $element_hash = {                  $element_hash = {
2792                      "title" => $fid1,                      "title" => $title,
2793                      "start" => $start,                      "start" => $start,
2794                      "end" =>  $stop,                      "end" =>  $stop,
2795                      "type"=> 'arrow',                      "type"=> 'arrow',
# Line 2434  Line 2802 
2802                  # if there is an overlap, put into second line                  # if there is an overlap, put into second line
2803                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}                  if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2804                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}                  else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2805    
2806                    if ($fid1 eq $fid){
2807                        $element_hash = {
2808                            "title" => 'Query',
2809                            "start" => $start,
2810                            "end" =>  $stop,
2811                            "type"=> 'bigbox',
2812                            "color"=> $color,
2813                            "zlayer" => "1"
2814                            };
2815    
2816                        # if there is an overlap, put into second line
2817                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2818                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2819                    }
2820              }              }
2821          }          }
2822          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
2823          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);          $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2824      }      }
2825      return $gd;      return ($gd, \@selected_sims);
2826  }  }
2827    
2828  sub cluster_genes {  sub cluster_genes {
# Line 2509  Line 2892 
2892      }      }
2893    
2894      for ($i=0; ($i < @$all_pegs); $i++) {      for ($i=0; ($i < @$all_pegs); $i++) {
2895          foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {          foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
2896              if (defined($x = $pos_of{$sim->id2})) {              if (defined($x = $pos_of{$sim->id2})) {
2897                  foreach $y (@$x) {                  foreach $y (@$x) {
2898                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
# Line 2527  Line 2910 
2910      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}      for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2911      return ($i < @$xL);      return ($i < @$xL);
2912  }  }
2913    
2914    #############################################
2915    #############################################
2916    package Observation::Commentary;
2917    
2918    use base qw(Observation);
2919    
2920    =head3 display_protein_commentary()
2921    
2922    =cut
2923    
2924    sub display_protein_commentary {
2925        my ($self,$dataset,$mypeg,$fig) = @_;
2926    
2927        my $all_rows = [];
2928        my $content;
2929        #my $fig = new FIG;
2930        my $cgi = new CGI;
2931        my $count = 0;
2932        my $peg_array = [];
2933        my (%evidence_column, %subsystems_column,  %e_identical);
2934    
2935        if (@$dataset != 1){
2936            foreach my $thing (@$dataset){
2937                if ($thing->class eq "SIM"){
2938                    push (@$peg_array, $thing->acc);
2939                }
2940            }
2941            # get the column for the evidence codes
2942            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2943    
2944            # get the column for the subsystems
2945            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2946    
2947            # get essentially identical seqs
2948            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2949        }
2950        else{
2951            push (@$peg_array, @$dataset);
2952        }
2953    
2954        my $selected_sims = [];
2955        foreach my $id (@$peg_array){
2956            last if ($count > 10);
2957            my $row_data = [];
2958            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2959            $org = $fig->org_of($id);
2960            $function = $fig->function_of($id);
2961            if ($mypeg ne $id){
2962                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
2963                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2964                if (defined($e_identical{$id})) { $id_cell .= "*";}
2965            }
2966            else{
2967                $function_cell = "&nbsp;&nbsp;$function";
2968                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
2969                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
2970            }
2971    
2972            push(@$row_data,$id_cell);
2973            push(@$row_data,$org);
2974            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2975            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2976            push(@$row_data, $fig->translation_length($id));
2977            push(@$row_data,$function_cell);
2978            push(@$all_rows,$row_data);
2979            push (@$selected_sims, $id);
2980            $count++;
2981        }
2982    
2983        if ($count >0){
2984            $content = $all_rows;
2985        }
2986        else{
2987            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2988        }
2989        return ($content,$selected_sims);
2990    }
2991    
2992    sub display_protein_history {
2993        my ($self, $id,$fig) = @_;
2994        my $all_rows = [];
2995        my $content;
2996    
2997        my $cgi = new CGI;
2998        my $count = 0;
2999        foreach my $feat ($fig->feature_annotations($id)){
3000            my $row = [];
3001            my $col1 = $feat->[2];
3002            my $col2 = $feat->[1];
3003            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3004            my $text = $feat->[3];
3005    
3006            push (@$row, $col1);
3007            push (@$row, $col2);
3008            push (@$row, $text);
3009            push (@$all_rows, $row);
3010            $count++;
3011        }
3012        if ($count > 0){
3013            $content = $all_rows;
3014        }
3015        else {
3016            $content = "There is no history for this PEG";
3017        }
3018    
3019        return($content);
3020    }
3021    

Legend:
Removed from v.1.40  
changed lines
  Added in v.1.59

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3