[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.17, Tue Jun 26 02:19:46 2007 UTC revision 1.60, Fri Jun 20 16:08:32 2008 UTC
# Line 1  Line 1 
1  package Observation;  package Observation;
2    
3    #use lib '/vol/ontologies';
4    use DBMaster;
5    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 23  Line 29 
29    
30  The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).  The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins).
31    
 Example:  
   
   
 use FIG;  
 use Observation;  
   
 my $fig = new FIG;  
 my $fid = "fig|83333.1.peg.3";  
   
 my $observations = Observation::get_objects($fid);  
 foreach my $observation (@$observations) {  
     print "ID: " . $fid . "\n";  
     print "Start: " . $observation->start() . "\n";  
     ...  
 }  
   
 B<return an array of objects>  
   
   
 print "$Observation->acc\n" prints the Accession number if present for the Observation  
   
32  =cut  =cut
33    
34  =head1 BACKGROUND  =head1 BACKGROUND
# Line 67  Line 52 
52    
53  The public methods this package provides are listed below:  The public methods this package provides are listed below:
54    
55    
56    =head3 context()
57    
58    Returns close or diverse for purposes of displaying genomic context
59    
60    =cut
61    
62    sub context {
63      my ($self) = @_;
64    
65      return $self->{context};
66    }
67    
68    =head3 rows()
69    
70    each row in a displayed table
71    
72    =cut
73    
74    sub rows {
75      my ($self) = @_;
76    
77      return $self->{rows};
78    }
79    
80  =head3 acc()  =head3 acc()
81    
82  A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.  A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported.
# Line 75  Line 85 
85    
86  sub acc {  sub acc {
87    my ($self) = @_;    my ($self) = @_;
   
88    return $self->{acc};    return $self->{acc};
89  }  }
90    
91  =head3 description()  =head3 query()
92    
93  The description of the hit. Taken from the data or from the our Ontology database for some cases e.g. IPR or PFAM.  The query id
   
 B<Please note:>  
 Either remoteid or description is required.  
94    
95  =cut  =cut
96    
97  sub description {  sub query {
98    my ($self) = @_;    my ($self) = @_;
99        return $self->{query};
   return $self->{description};  
100  }  }
101    
102    
103  =head3 class()  =head3 class()
104    
105  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.  The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure.
# Line 121  Line 127 
127    
128  =item SIGNALP_CELLO_TMPRED (loc)  =item SIGNALP_CELLO_TMPRED (loc)
129    
130    =item PDB (seq)
131    
132  =item TMHMM (loc)  =item TMHMM (loc)
133    
134  =item HMMTOP (loc)  =item HMMTOP (loc)
# Line 158  Line 166 
166  sub type {  sub type {
167    my ($self) = @_;    my ($self) = @_;
168    
169    return $self->{acc};    return $self->{type};
170  }  }
171    
172  =head3 start()  =head3 start()
# Line 257  Line 265 
265      return $self->{hlength};      return $self->{hlength};
266  }  }
267    
   
   
268  =head3 evalue()  =head3 evalue()
269    
270  E-value or P-Value if present.  E-value or P-Value if present.
# Line 275  Line 281 
281    
282  Score if present.  Score if present.
283    
 B<Please note: >  
 Either score or eval are required.  
   
284  =cut  =cut
285    
286  sub score {  sub score {
# Line 285  Line 288 
288    return $self->{score};    return $self->{score};
289  }  }
290    
   
291  =head3 display()  =head3 display()
292    
293  will be different for each type  will be different for each type
# Line 298  Line 300 
300    
301  }  }
302    
303    =head3 display_table()
304    
305  =head3 rank()  will be different for each type
   
 Returns an integer from 1 - 10 indicating the importance of this observations.  
   
 Currently always returns 1.  
   
 =cut  
   
 sub rank {  
   my ($self) = @_;  
   
 #  return $self->{rank};  
   
   return 1;  
 }  
   
 =head3 supports_annotation()  
   
 Does a this observation support the annotation of its feature?  
   
 Returns  
   
 =over 3  
   
 =item 10, if feature annotation is identical to $self->description  
   
 =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()  
   
 =item undef  
   
 =back  
   
 =cut  
   
 sub supports_annotation {  
   my ($self) = @_;  
   
   # no code here so far  
   
   return $self->{supports_annotation};  
 }  
   
 =head3 url()  
   
 URL describing the subject. In case of a BLAST hit against a sequence, this URL will lead to a page displaying the sequence record for the sequence. In case of an HMM hit, the URL will be to the URL description.  
306    
307  =cut  =cut
308    
309  sub url {  sub display_table {
   my ($self) = @_;  
310    
311    my $url = get_url($self->type, $self->acc);    die "Abstract Table Method Called\n";
312    
   return $url;  
313  }  }
314    
315  =head3 get_objects()  =head3 get_objects()
316    
317  This is the B<REAL WORKHORSE> method of this Package.  This is the B<REAL WORKHORSE> method of this Package.
318    
 It will probably have to:  
   
 - get all sims for the feature  
 - get all bbhs for the feature  
 - copy information from sim to bbh (bbh have no match location etc)  
 - get pchs (difficult)  
 - get attributes (there is code for this that in get_attribute_based_observations  
 - get_attributes_based_observations returns an array of arrays of hashes like this"  
   
   my $dataset  
      [  
        [ { name => 'acc', value => '1234' },  
         { name => 'from', value => '4' },  
         { name => 'to', value => '400' },  
         ....  
        ],  
        [ { name => 'acc', value => '456' },  
         { name => 'from', value => '1' },  
         { name => 'to', value => '100' },  
         ....  
        ],  
        ...  
      ];  
    return $datasets;  
  }  
   
 It will invoke the required calls to the SEED API to retrieve the information required.  
   
319  =cut  =cut
320    
321  sub get_objects {  sub get_objects {
322      my ($self,$fid,$classes) = @_;      my ($self,$fid,$fig,$scope) = @_;
   
323    
324      my $objects = [];      my $objects = [];
325      my @matched_datasets=();      my @matched_datasets=();
# Line 399  Line 327 
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
329    
330      if(scalar(@$classes) < 1){      if($scope){
331          get_attribute_based_observations($fid,\@matched_datasets);          get_cluster_observations($fid,\@matched_datasets,$scope);
         get_sims_observations($fid,\@matched_datasets);  
         get_identical_proteins($fid,\@matched_datasets);  
         get_functional_coupling($fid,\@matched_datasets);  
332      }      }
333      else{      else{
334          my %domain_classes;          my %domain_classes;
335          my $identical_flag=0;          my @attributes = $fig->get_attributes($fid);
336          my $pch_flag=0;          $domain_classes{'CDD'} = 1;
337          my $location_flag = 0;          $domain_classes{'PFAM'} = 1;
338          my $sims_flag=0;          get_identical_proteins($fid,\@matched_datasets,$fig);
339          my $cluster_flag = 0;          get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
340          foreach my $class (@$classes){          get_sims_observations($fid,\@matched_datasets,$fig);
341              if($class =~ /(IPR|CDD|PFAM)/){          get_functional_coupling($fid,\@matched_datasets,$fig);
342                  $domain_classes{$class} = 1;          get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
343              }          get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
             elsif ($class eq "IDENTICAL")  
             {  
                 $identical_flag = 1;  
             }  
             elsif ($class eq "PCH")  
             {  
                 $pch_flag = 1;  
             }  
             elsif ($class =~/(SIGNALP_CELLO_TMPRED)/)  
             {  
                 $location_flag = 1;  
             }  
             elsif ($class eq "SIM")  
             {  
                 $sims_flag = 1;  
             }  
             elsif ($class eq "CLUSTER")  
             {  
                 $cluster_flag = 1;  
             }  
         }  
   
         if ($identical_flag ==1)  
         {  
             get_identical_proteins($fid,\@matched_datasets);  
         }  
         if ( (defined($domain_classes{IPR})) || (defined($domain_classes{CDD})) || (defined($domain_classes{PFAM})) ) {  
             get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets);  
         }  
         if ($pch_flag == 1)  
         {  
             get_functional_coupling($fid,\@matched_datasets);  
         }  
         if ($sims_flag == 1)  
         {  
             get_sims_observations($fid,\@matched_datasets);  
         }  
   
         if ($location_flag == 1)  
         {  
             get_attribute_based_location_observations($fid,\@matched_datasets);  
         }  
         if ($cluster_flag == 1)  
         {  
             get_cluster_observations($fid,\@matched_datasets);  
         }  
   
344      }      }
345    
346      foreach my $dataset (@matched_datasets) {      foreach my $dataset (@matched_datasets) {
# Line 470  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            elsif ($dataset->{'class'} eq "PDB"){
367                $object = Observation::PDB->new($dataset);
368            }
369    
370          push (@$objects, $object);          push (@$objects, $object);
371      }      }
372    
# Line 492  Line 374 
374    
375  }  }
376    
377  =head1 Internal Methods  =head3 get_sims_objects()
   
 These methods are not meant to be used outside of this package.  
378    
379  B<Please do not use them outside of this package!>  This is the B<REAL WORKHORSE> method of this Package.
380    
381  =cut  =cut
382    
383    sub get_sims_objects {
384        my ($self,$fid,$fig,$parameters) = @_;
385    
386        my $objects = [];
387        my @matched_datasets=();
388    
389  =head3 get_url (internal)      # call function that fetches attribute based observations
390        # returns an array of arrays of hashes
391        get_sims_observations($fid,\@matched_datasets,$fig,$parameters);
392    
393  get_url() return a valid URL or undef for any observation.      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;
401    }
402    
 URLs are constructed by looking at the Accession acc()  and  name()  
403    
404  Info from both attributes is combined with a table of base URLs stored in this function.  =head3 display_housekeeping
405    This method returns the housekeeping data for a given peg in a table format
406    
407  =cut  =cut
408    sub display_housekeeping {
409        my ($self,$fid,$fig) = @_;
410        my $content = [];
411        my $row = [];
412    
413        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  sub get_url {      push(@$content, $row);
434    
435   my ($self) = @_;      return ($content);
436   my $url='';  }
437    
438  # a hash with a URL for each observation; identified by name()  =head3 get_sims_summary
439  #my $URL             => { 'PFAM' => "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?" ,\  This method uses as input the similarities of a peg and creates a tree view of their taxonomy
 #                       'IPR'    => "http://www.ebi.ac.uk/interpro/DisplayIproEntry?ac=" ,\  
 #                          'CDD' => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\  
 #                       'PIR'    => "http://www.ncbi.nlm.nih.gov/Structure/cdd/cddsrv.cgi?uid=",\  
 #                       'FIGFAM' => '',\  
 #                          'sim'=> "http://www.theseed.org/linkin.cgi?id=",\  
 #                          'bbh'=> "http://www.theseed.org/linkin.cgi?id="  
 #};  
440    
441  # if (defined $URL{$self->name}) {  =cut
442  #     $url = $URL{$self->name}.$self->acc;  
443  #     return $url;  sub get_sims_summary {
444  # }      my ($observation, $dataset, $fig) = @_;
445  # else      my %families;
446       return undef;      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            my $genome = $fig->genome_of($id);
463            #my ($genome1) = ($genome) =~ /(.*)\./;
464            my $taxonomy = $taxes->{$genome};
465            my $parent_tax = "Root";
466            my @currLineage = ($parent_tax);
467            push (@{$families{figs}{$parent_tax}}, $id);
468            my $level = 2;
469            foreach my $tax (split(/\; /, $taxonomy)){
470                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);
474                $families{parent}{$tax} = $parent_tax;
475                $families{lineage}{$tax} = join(";", @currLineage);
476                if (defined ($families{evalue}{$tax})){
477                    if ($evalue < $families{evalue}{$tax}){
478                        $families{evalue}{$tax} = $evalue;
479                        $families{color}{$tax} = &get_taxcolor($evalue);
480                    }
481                }
482                else{
483                    $families{evalue}{$tax} = $evalue;
484                    $families{color}{$tax} = &get_taxcolor($evalue);
485  }  }
486    
487  =head3 get_display_method (internal)              $parent_tax = $tax;
488                $level++;
489            }
490        }
491    
492  get_display_method() return a valid URL or undef for any observation.      foreach my $key (keys %{$families{children}}){
493            $families{count}{$key} = @{$families{children}{$key}};
494    
495  URLs are constructed by looking at the Accession acc()  and  name()          my %saw;
496  and Info from both attributes is combined with a table of base URLs stored in this function.          my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
497            $families{children}{$key} = \@out;
498        }
499    
500  =cut      return \%families;
501    }
502    
503  sub get_display_method {  =head1 Internal Methods
504    
505   my ($self) = @_;  These methods are not meant to be used outside of this package.
506    
507  # a hash with a URL for each observation; identified by name()  B<Please do not use them outside of this package!>
 #my $URL             => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\  
 #                        'bbh'=> "http://www.theseed.org/featalign.cgi?id1="  
 # };  
508    
509  #if (defined $URL{$self->name}) {  =cut
510  #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;  
511  #     return $url;  sub get_taxcolor{
512  # }      my ($evalue) = @_;
513  # else      my $color;
514       return undef;      if ($evalue == -1){            $color = "black";      }
515        elsif (($evalue <= 1e-170) && ($evalue >= 0)){        $color = "#FF2000";    }
516        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
517        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
518        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
519        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
520        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
521        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
522        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
523        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
524        else{        $color = "#6666FF";    }
525        return ($color);
526  }  }
527    
528    
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) = (@_);      my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
   
     my $fig = new FIG;  
533    
534      foreach my $attr_ref ($fig->get_attributes($fid)) {      foreach my $attr_ref (@$attributes_ref) {
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 580  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 594  Line 562 
562                                 'type' => "dom" ,                                 'type' => "dom" ,
563                                 'evalue' => $evalue,                                 'evalue' => $evalue,
564                                 'start' => $from,                                 'start' => $from,
565                                 'stop' => $to                                 'stop' => $to,
566                                   'fig_id' => $fid,
567                                   'score' => $raw_evalue
568                                 };                                 };
569    
570                  push (@{$datasets_ref} ,$dataset);                  push (@{$datasets_ref} ,$dataset);
# Line 605  Line 575 
575    
576  sub get_attribute_based_location_observations{  sub get_attribute_based_location_observations{
577    
578      my ($fid,$datasets_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'];      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
582    
583      my $dataset = {'type' => "loc", 'class' => 'SIGNALP_CELLO_TMPRED'};      my $dataset = {'type' => "loc",
584      foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) {                     'class' => 'SIGNALP_CELLO_TMPRED',
585                       'fig_id' => $fid
586                       };
587    
588        foreach my $attr_ref (@$attributes_ref){
589          my $key = @$attr_ref[1];          my $key = @$attr_ref[1];
590            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
591          my @parts = split("::",$key);          my @parts = split("::",$key);
592          my $sub_class = $parts[0];          my $sub_class = $parts[0];
593          my $sub_key = $parts[1];          my $sub_key = $parts[1];
# Line 627  Line 602 
602                  $dataset->{'signal_peptide_score'} = $value;                  $dataset->{'signal_peptide_score'} = $value;
603              }              }
604          }          }
605    
606          elsif($sub_class eq "CELLO"){          elsif($sub_class eq "CELLO"){
607              $dataset->{'cello_location'} = $sub_key;              $dataset->{'cello_location'} = $sub_key;
608              $dataset->{'cello_score'} = $value;              $dataset->{'cello_score'} = $value;
609          }          }
610    
611            elsif($sub_class eq "Phobius"){
612                if($sub_key eq "transmembrane"){
613                    $dataset->{'phobius_tm_locations'} = $value;
614                }
615                elsif($sub_key eq "signal"){
616                    $dataset->{'phobius_signal_location'} = $value;
617                }
618            }
619    
620          elsif($sub_class eq "TMPRED"){          elsif($sub_class eq "TMPRED"){
621              my @value_parts = split(";",$value);              my @value_parts = split(/\;/,$value);
622              $dataset->{'tmpred_score'} = $value_parts[0];              $dataset->{'tmpred_score'} = $value_parts[0];
623              $dataset->{'tmpred_locations'} = $value_parts[1];              $dataset->{'tmpred_locations'} = $value_parts[1];
624          }          }
# Line 642  Line 628 
628    
629  }  }
630    
631    =head3 get_pdb_observations() (internal)
632    
633  =head3 get_attribute_based_evidence (internal)  This methods sets the type and class for pdb observations
   
 This method retrieves evidence from the attribute server  
634    
635  =cut  =cut
636    
637  sub get_attribute_based_observations{  sub get_pdb_observations{
638        my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
     # we read a FIG ID and a reference to an array (of arrays of hashes, see above)  
     my ($fid,$datasets_ref) = (@_);  
   
     my $_myfig = new FIG;  
   
     foreach my $attr_ref ($_myfig->get_attributes($fid)) {  
   
         # convert the ref into a string for easier handling  
         my ($string) = "@$attr_ref";  
   
 #       print "S:$string\n";  
         my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);  
639    
640          # THIS SHOULD BE DONE ANOTHER WAY FM->TD      #my $fig = new FIG;
         # we need to do the right thing for each type, ie no evalue for CELLO and no coordinates, but a score, etc  
         # as fas as possible this should be configured so that the type of observation and the regexp are  
         # stored somewhere for easy expansion  
         #  
641    
642          if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {      foreach my $attr_ref (@$attributes_ref){
643            my $key = @$attr_ref[1];
644              # some keys are composite CDD::1233244 or PFAM:PF1233          next if ( ($key !~ /PDB/));
645            my($key1,$key2) =split("::",$key);
646            my $value = @$attr_ref[2];
647            my ($evalue,$location) = split(";",$value);
648    
649              if ( $key =~ /::/ ) {          if($evalue =~/(\d+)\.(\d+)/){
650                  my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);              my $part2 = 1000 - $1;
651                  $val=$restkey.";".$val;              my $part1 = $2/100;
652                  $key=$firstkey;              $evalue = $part1."e-".$part2;
653              }              }
654    
655              my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );          my($start,$stop) =split("-",$location);
   
             my $evalue= 255;  
             if (defined $raw_evalue) { # some of the tool do not give us an evalue  
   
                 my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);  
                 my ($new_k, $new_exp);  
656    
657                  #          my $url = @$attr_ref[3];
658                  #  THIS DOES NOT WORK PROPERLY          my $dataset = {'class' => 'PDB',
659                  #                         'type' => 'seq' ,
660                  if($raw_evalue =~/(\d+).(\d+)/){                         'acc' => $key2,
661                           'evalue' => $evalue,
662  #                   $new_exp = (1000+$expo);                         'start' => $start,
663          #           $new_k = $k / 100;                         'stop' => $stop,
664                           'fig_id' => $fid
665                  }                         };
                 $evalue = "0.01"#new_k."e-".$new_exp;  
             }  
   
             # unroll it all into an array of hashes  
             # this needs to be done differently for different types of observations  
             my $dataset = [ { name => 'class', value => $key },  
                             { name => 'acc' , value => $acc},  
                             { name => 'type', value => "dom"} , # this clearly needs to be done properly FM->TD  
                             { name => 'evalue', value => $evalue },  
                             { name => 'start', value => $from},  
                             { name => 'stop' , value => $to}  
                             ];  
666    
667              push (@{$datasets_ref} ,$dataset);              push (@{$datasets_ref} ,$dataset);
668          }          }
669      }      }
 }  
670    
671  =head3 get_cluster_observations() (internal)  =head3 get_cluster_observations() (internal)
672    
# Line 722  Line 675 
675  =cut  =cut
676    
677  sub get_cluster_observations{  sub get_cluster_observations{
678      my ($fid,$datasets_ref) = (@_);      my ($fid,$datasets_ref,$scope) = (@_);
679    
680      my $dataset = {'class' => 'CLUSTER',      my $dataset = {'class' => 'CLUSTER',
681                     'type' => 'fc'                     'type' => 'fc',
682                       'context' => $scope,
683                       'fig_id' => $fid
684                     };                     };
685      push (@{$datasets_ref} ,$dataset);      push (@{$datasets_ref} ,$dataset);
686  }  }
# Line 738  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 ($max_sims, $max_expand, $max_eval, $sim_order, $db_filter);
699        if ($parameters->{flag}){
700          $max_sims = $parameters->{max_sims};
701          $max_expand = $parameters->{max_expand};
702          $max_eval = $parameters->{max_eval};
703          $db_filter = $parameters->{db_filter};
704          $sim_order = $parameters->{sim_order};
705          $group_by_genome = 1 if (defined ($parameters->{group_genome}));
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 ($fid,$datasets_ref) = (@_);      my($id, $genome, @genomes, %sims);
716      my $fig = new FIG;      my @tmp= $fig->sims($fid,$max_sims,$max_eval,$db_filter,$max_expand);
717  #    my @sims= $fig->nsims($fid,100,1e-20,"fig");      @tmp = grep { !($_->id2 =~ /^fig\|/ and $fig->is_deleted_fid($_->id2)) } @tmp;
     my @sims= $fig->nsims($fid,100,1e-20,"all");  
718      my ($dataset);      my ($dataset);
719      foreach my $sim (@sims){  
720        if ($group_by_genome){
721          #  Collect all sims from genome with the first occurance of the genome:
722          foreach $sim ( @tmp ){
723            $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 (@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 759  Line 743 
743          my $organism = $fig->org_of($hit);          my $organism = $fig->org_of($hit);
744    
745          $dataset = {'class' => 'SIM',          $dataset = {'class' => 'SIM',
746                        'query' => $sim->[0],
747                      'acc' => $hit,                      'acc' => $hit,
748                      'identity' => $percent,                      'identity' => $percent,
749                      'type' => 'seq',                      'type' => 'seq',
# Line 771  Line 756 
756                      'organism' => $organism,                      'organism' => $organism,
757                      'function' => $func,                      'function' => $func,
758                      'qlength' => $qlength,                      'qlength' => $qlength,
759                      'hlength' => $hlength                      'hlength' => $hlength,
760                        'fig_id' => $fid
761                      };                      };
762    
763          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
# Line 787  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" }
784      elsif ($id =~ /^pir\|/)           { $db = "PIR" }      elsif ($id =~ /^pir\|/)           { $db = "PIR" }
785      elsif ($id =~ /^kegg\|/)          { $db = "KEGG" }      elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
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    
796  }  }
797    
798    
799  =head3 get_identical_proteins() (internal)  =head3 get_identical_proteins() (internal)
800    
801  This methods retrieves sims fills the internal data structures.  This methods retrieves sims fills the internal data structures.
# Line 811  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 = ();      my $funcs_ref;
810    
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);
   
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))) {
815              $who = &get_database($id);              $who = &get_database($id);
816              push(@funcs, [$id,$who,$tmp]);              push(@$funcs_ref, [$id,$who,$tmp]);
817          }          }
818      }      }
819    
     my ($dataset);  
     foreach my $row (@funcs){  
         my $id = $row->[0];  
         my $organism = $fig->org_of($fid);  
         my $who = $row->[1];  
         my $assignment = $row->[2];  
   
820          my $dataset = {'class' => 'IDENTICAL',          my $dataset = {'class' => 'IDENTICAL',
                        'id' => $id,  
                        'organism' => $organism,  
821                         'type' => 'seq',                         'type' => 'seq',
822                         'database' => $who,                     'fig_id' => $fid,
823                         'function' => $assignment                     'rows' => $funcs_ref
824                         };                         };
825    
826          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
827      }  
828    
829  }  }
830    
# Line 853  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 871  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);  
     foreach my $row (@rows){  
         my $id = $row->[1];  
         my $score = $row->[0];  
         my $description = $row->[2];  
857          my $dataset = {'class' => 'PCH',          my $dataset = {'class' => 'PCH',
                        'score' => $score,  
                        'id' => $id,  
858                         'type' => 'fc',                         'type' => 'fc',
859                         'function' => $description                     'fig_id' => $fid,
860                       'rows' => \@rows
861                         };                         };
862    
863          push (@{$datasets_ref} ,$dataset);          push (@{$datasets_ref} ,$dataset);
     }  
 }  
   
 =head3 get_sims_and_bbhs() (internal)  
   
 This methods retrieves sims and also BBHs and fills the internal data structures.  
   
 =cut  
   
 #     sub get_sims_and_bbhs{  
   
 #       # blast m8 output format  
 #       # id1, id2, %ident, align len, mismatches, gaps, q.start, q.stop, s. start, s.stop, eval, bit  
   
 #       my $Sims=();  
 #       @sims_src = $fig->sims($fid,80,500,"fig",0);  
 #       print "found $#sims_src SIMs\n";  
 #       foreach $sims (@sims_src) {  
 #           my ($sims_string) = "@$sims";  
 # #       print "$sims_string\n";  
 #           my ($rfid,$start,$stop,$eval) = ( $sims_string =~ /\S+\s+(\S+)\s+\S+\s\S+\s+(\S+)\s+(\S+)\s+  
 #                                             \S+\s+\S+\s+\S+\s+\S+\s+(\S+)+.*/);  
 # #       print "ID: $rfid, E:$eval, Start:$start stop:$stop\n";  
 #           $Sims{$rfid}{'eval'}=$eval;  
 #           $Sims{$rfid}{'start'}=$start;  
 #           $Sims{$rfid}{'stop'}=$stop;  
 #           print "$rfid $Sims{$rfid}{'eval'}\n";  
 #       }  
   
 #       # BBHs  
 #       my $BBHs=();  
   
 #       @bbhs_src = $fig->bbhs($fid,1.0e-10);  
 #       print "found $#bbhs_src BBHs\n";  
 #       foreach $bbh (@bbhs_src) {  
 #           #print "@$bbh\n";  
 #           my ($bbh_string) = "@$bbh";  
 #           my ($rfid,$eval,$score) = ( $bbh_string =~ /(\S+)\s(\S+)\s(\S+)/);  
 #           #print "ID: $rfid, E:$eval, S:$score\n";  
 #           $BBHs{$rfid}{'eval'}=$eval;  
 #           $BBHs{$rfid}{'score'}=$score;  
 # #print "$rfid $BBHs{$rfid}{'eval'}\n";  
 #       }  
   
 #     }  
   
864    
865    }
866    
867  =head3 new (internal)  =head3 new (internal)
868    
# Line 941  Line 873 
873  sub new {  sub new {
874    my ($class,$dataset) = @_;    my ($class,$dataset) = @_;
875    
   
   #$self = { acc => '',  
 #           description => '',  
 #           class => '',  
 #           type => '',  
 #           start => '',  
 #           stop => '',  
 #           evalue => '',  
 #           score => '',  
 #           display_method => '',  
 #           feature_id => '',  
 #           rank => '',  
 #           supports_annotation => '',  
 #           id => '',  
 #            organism => '',  
 #            who => ''  
 #         };  
   
876    my $self = { class => $dataset->{'class'},    my $self = { class => $dataset->{'class'},
877                 type => $dataset->{'type'}                 type => $dataset->{'type'},
878                   fig_id => $dataset->{'fig_id'},
879                   score => $dataset->{'score'},
880             };             };
881    
882    bless($self,$class);    bless($self,$class);
# Line 980  Line 896 
896      return $self->{identity};      return $self->{identity};
897  }  }
898    
899    =head3 fig_id (internal)
900    
901    =cut
902    
903    sub fig_id {
904      my ($self) = @_;
905      return $self->{fig_id};
906    }
907    
908  =head3 feature_id (internal)  =head3 feature_id (internal)
909    
910    
# Line 1039  Line 964 
964      return $self->{database};      return $self->{database};
965  }  }
966    
   
   
967  ############################################################  ############################################################
968  ############################################################  ############################################################
969  package Observation::Identical;  package Observation::PDB;
970    
971  use base qw(Observation);  use base qw(Observation);
972    
# Line 1051  Line 974 
974    
975      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
976      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
977      $self->{id} = $dataset->{'id'};      $self->{acc} = $dataset->{'acc'};
978      $self->{organism} = $dataset->{'organism'};      $self->{evalue} = $dataset->{'evalue'};
979      $self->{function} = $dataset->{'function'};      $self->{start} = $dataset->{'start'};
980      $self->{database} = $dataset->{'database'};      $self->{stop} = $dataset->{'stop'};
   
981      bless($self,$class);      bless($self,$class);
982      return $self;      return $self;
983  }  }
984    
985  =head3 display()  =head3 display()
986    
987  If available use the function specified here to display the "raw" observation.  displays data stored in best_PDB attribute and in Ontology server for given PDB id
 This code will display a table for the identical protein  
   
   
 B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evi  
 dence.  
988    
989  =cut  =cut
990    
991  sub display{  sub display{
992      my ($self, $cgi, $dataset) = @_;      my ($self,$gd,$fig) = @_;
993    
994      my $all_domains = [];      my $fid = $self->fig_id;
995      my $count_identical = 0;      my $dbmaster = DBMaster->new(-database =>'Ontology',
996      my $content;                                  -host     => $WebConfig::DBHOST,
997      foreach my $thing (@$dataset) {                                  -user     => $WebConfig::DBUSER,
998          next if ($thing->class ne "IDENTICAL");                                  -password => $WebConfig::DBPWD);
999          my $single_domain = [];  
1000          push(@$single_domain,$thing->database);      my $acc = $self->acc;
1001          my $id = $thing->id;  
1002          $count_identical++;      my ($pdb_description,$pdb_source,$pdb_ligand);
1003          push(@$single_domain,&HTML::set_prot_links($cgi,$id));      my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
1004          push(@$single_domain,$thing->organism);      if(!scalar(@$pdb_objs)){
1005          #push(@$single_domain,$thing->type);          $pdb_description = "not available";
1006          push(@$single_domain,$thing->function);          $pdb_source = "not available";
1007          push(@$all_domains,$single_domain);          $pdb_ligand = "not available";
1008        }
1009        else{
1010            my $pdb_obj = $pdb_objs->[0];
1011            $pdb_description = $pdb_obj->description;
1012            $pdb_source = $pdb_obj->source;
1013            $pdb_ligand = $pdb_obj->ligand;
1014        }
1015    
1016        my $lines = [];
1017        my $line_data = [];
1018        my $line_config = { 'title' => "PDB hit for $fid",
1019                            'hover_title' => 'PDB',
1020                            'short_title' => "best PDB",
1021                            'basepair_offset' => '1' };
1022    
1023        #my $fig = new FIG;
1024        my $seq = $fig->get_translation($fid);
1025        my $fid_stop = length($seq);
1026    
1027        my $fid_element_hash = {
1028            "title" => $fid,
1029            "start" => '1',
1030            "end" =>  $fid_stop,
1031            "color"=> '1',
1032            "zlayer" => '1'
1033            };
1034    
1035        push(@$line_data,$fid_element_hash);
1036    
1037        my $links_list = [];
1038        my $descriptions = [];
1039    
1040        my $name;
1041        $name = {"title" => 'id',
1042                 "value" => $acc};
1043        push(@$descriptions,$name);
1044    
1045        my $description;
1046        $description = {"title" => 'pdb description',
1047                        "value" => $pdb_description};
1048        push(@$descriptions,$description);
1049    
1050        my $score;
1051        $score = {"title" => "score",
1052                  "value" => $self->evalue};
1053        push(@$descriptions,$score);
1054    
1055        my $start_stop;
1056        my $start_stop_value = $self->start."_".$self->stop;
1057        $start_stop = {"title" => "start-stop",
1058                       "value" => $start_stop_value};
1059        push(@$descriptions,$start_stop);
1060    
1061        my $source;
1062        $source = {"title" => "source",
1063                  "value" => $pdb_source};
1064        push(@$descriptions,$source);
1065    
1066        my $ligand;
1067        $ligand = {"title" => "pdb ligand",
1068                   "value" => $pdb_ligand};
1069        push(@$descriptions,$ligand);
1070    
1071        my $link;
1072        my $link_url ="http://www.rcsb.org/pdb/explore/explore.do?structureId=".$acc;
1073    
1074        $link = {"link_title" => $acc,
1075                 "link" => $link_url};
1076        push(@$links_list,$link);
1077    
1078        my $pdb_element_hash = {
1079            "title" => "PDB homology",
1080            "start" => $self->start,
1081            "end" =>  $self->stop,
1082            "color"=> '6',
1083            "zlayer" => '3',
1084            "links_list" => $links_list,
1085            "description" => $descriptions};
1086    
1087        push(@$line_data,$pdb_element_hash);
1088        $gd->add_line($line_data, $line_config);
1089    
1090        return $gd;
1091    }
1092    
1093    1;
1094    
1095    ############################################################
1096    ############################################################
1097    package Observation::Identical;
1098    
1099    use base qw(Observation);
1100    
1101    sub new {
1102    
1103        my ($class,$dataset) = @_;
1104        my $self = $class->SUPER::new($dataset);
1105        $self->{rows} = $dataset->{'rows'};
1106    
1107        bless($self,$class);
1108        return $self;
1109    }
1110    
1111    =head3 display_table()
1112    
1113    If available use the function specified here to display the "raw" observation.
1114    This code will display a table for the identical protein
1115    
1116    
1117    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evi
1118    dence.
1119    
1120    =cut
1121    
1122    
1123    sub display_table{
1124        my ($self,$fig) = @_;
1125    
1126        #my $fig = new FIG;
1127        my $fid = $self->fig_id;
1128        my $rows = $self->rows;
1129        my $cgi = new CGI;
1130        my $all_domains = [];
1131        my $count_identical = 0;
1132        my $content;
1133        foreach my $row (@$rows) {
1134            my $id = $row->[0];
1135            my $who = $row->[1];
1136            my $assignment = $row->[2];
1137            my $organism = $fig->org_of($id);
1138            my $single_domain = [];
1139            push(@$single_domain,$who);
1140            push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1141            push(@$single_domain,$organism);
1142            push(@$single_domain,$assignment);
1143            push(@$all_domains,$single_domain);
1144            $count_identical++;
1145      }      }
1146    
1147      if ($count_identical >0){      if ($count_identical >0){
# Line 1101  Line 1155 
1155    
1156  1;  1;
1157    
   
1158  #########################################  #########################################
1159  #########################################  #########################################
1160  package Observation::FC;  package Observation::FC;
# Line 1113  Line 1166 
1166    
1167      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
1168      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1169      $self->{score} = $dataset->{'score'};      $self->{rows} = $dataset->{'rows'};
     $self->{id} = $dataset->{'id'};  
     $self->{function} = $dataset->{'function'};  
1170    
1171      bless($self,$class);      bless($self,$class);
1172      return $self;      return $self;
1173  }  }
1174    
1175  =head3 display()  =head3 display_table()
1176    
1177  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display the "raw" observation.
1178  This code will display a table for the identical protein  This code will display a table for the identical protein
# Line 1132  Line 1183 
1183    
1184  =cut  =cut
1185    
1186  sub display {  sub display_table {
     my ($self,$cgi,$dataset, $fid) = @_;  
1187    
1188        my ($self,$dataset,$fig) = @_;
1189        my $fid = $self->fig_id;
1190        my $rows = $self->rows;
1191        my $cgi = new CGI;
1192      my $functional_data = [];      my $functional_data = [];
1193      my $count = 0;      my $count = 0;
1194      my $content;      my $content;
1195    
1196      foreach my $thing (@$dataset) {      foreach my $row (@$rows) {
1197          my $single_domain = [];          my $single_domain = [];
         next if ($thing->class ne "PCH");  
1198          $count++;          $count++;
1199    
1200          # construct the score link          # construct the score link
1201          my $score = $thing->score;          my $score = $row->[0];
1202          my $toid = $thing->id;          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,$thing->id);          push(@$single_domain,$row->[1]);
1208          push(@$single_domain,$thing->function);          push(@$single_domain,$row->[2]);
1209          push(@$functional_data,$single_domain);          push(@$functional_data,$single_domain);
1210      }      }
1211    
# Line 1189  Line 1242 
1242  sub display {  sub display {
1243      my ($thing,$gd) = @_;      my ($thing,$gd) = @_;
1244      my $lines = [];      my $lines = [];
1245      my $line_config = { 'title' => $thing->acc,  #    my $line_config = { 'title' => $thing->acc,
1246                          'short_title' => $thing->type,  #                       'short_title' => $thing->type,
1247                          'basepair_offset' => '1' };  #                       'basepair_offset' => '1' };
1248      my $color = "4";      my $color = "4";
1249    
1250      my $line_data = [];      my $line_data = [];
1251      my $links_list = [];      my $links_list = [];
1252      my $descriptions = [];      my $descriptions = [];
1253    
1254      my $description_function;      my $db_and_id = $thing->acc;
1255      $description_function = {"title" => $thing->class,      my ($db,$id) = split("::",$db_and_id);
                              "value" => $thing->acc};  
1256    
1257      push(@$descriptions,$description_function);      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);
1263        if($db eq "CDD"){
1264            my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1265            if(!scalar(@$cdd_objs)){
1266                $name_title = "name";
1267                $name_value = "not available";
1268                $description_title = "description";
1269                $description_value = "not available";
1270            }
1271            else{
1272                my $cdd_obj = $cdd_objs->[0];
1273                $name_title = "name";
1274                $name_value = $cdd_obj->term;
1275                $description_title = "description";
1276                $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 $short_title = $thing->acc;
1298        $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' };
1307    
1308        my $name;
1309        my ($new_id) = ($id) =~ /(.*?)_/;
1310        $name = {"title" => $db,
1311                 "value" => $new_id};
1312        push(@$descriptions,$name);
1313    
1314    #    my $description;
1315    #    $description = {"title" => $description_title,
1316    #                   "value" => $description_value};
1317    #    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 1225  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 1240  Line 1357 
1357    
1358  }  }
1359    
1360    sub display_table {
1361        my ($self,$dataset) = @_;
1362        my $cgi = new CGI;
1363        my $data = [];
1364        my $count = 0;
1365        my $content;
1366    
1367        foreach my $thing (@$dataset) {
1368            next if ($thing->type !~ /dom/);
1369            my $single_domain = [];
1370            $count++;
1371    
1372            my $db_and_id = $thing->acc;
1373            my ($db,$id) = split("::",$db_and_id);
1374    
1375            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);
1381            if($db eq "CDD"){
1382                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1383                if(!scalar(@$cdd_objs)){
1384                    $name_title = "name";
1385                    $name_value = "not available";
1386                    $description_title = "description";
1387                    $description_value = "not available";
1388                }
1389                else{
1390                    my $cdd_obj = $cdd_objs->[0];
1391                    $name_title = "name";
1392                    $name_value = $cdd_obj->term;
1393                    $description_title = "description";
1394                    $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;
1416    
1417            push(@$single_domain,$db);
1418            push(@$single_domain,$thing->acc);
1419            push(@$single_domain,$name_value);
1420            push(@$single_domain,$location);
1421            push(@$single_domain,$thing->evalue);
1422            push(@$single_domain,$description_value);
1423            push(@$data,$single_domain);
1424        }
1425    
1426        if ($count >0){
1427            $content = $data;
1428        }
1429        else
1430        {
1431            $content = "<p>This PEG does not have any similarities to domains</p>";
1432        }
1433    }
1434    
1435    
1436  #########################################  #########################################
1437  #########################################  #########################################
1438  package Observation::Location;  package Observation::Location;
# Line 1257  Line 1450 
1450      $self->{cello_score} = $dataset->{'cello_score'};      $self->{cello_score} = $dataset->{'cello_score'};
1451      $self->{tmpred_score} = $dataset->{'tmpred_score'};      $self->{tmpred_score} = $dataset->{'tmpred_score'};
1452      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};      $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1453        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1454        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1455    
1456      bless($self,$class);      bless($self,$class);
1457      return $self;      return $self;
1458  }  }
1459    
1460    sub display_cello {
1461        my ($thing) = @_;
1462        my $html;
1463        my $cello_location = $thing->cello_location;
1464        my $cello_score = $thing->cello_score;
1465        if($cello_location){
1466            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1467            #$html .= "<p>CELLO score: $cello_score </p>";
1468        }
1469        return ($html);
1470    }
1471    
1472  sub display {  sub display {
1473      my ($thing,$gd,$fid) = @_;      my ($thing,$gd,$fig) = @_;
1474    
1475      my $fig= new FIG;      my $fid = $thing->fig_id;
1476        #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 1277  Line 1485 
1485      my $tmpred_score = $thing->tmpred_score;      my $tmpred_score = $thing->tmpred_score;
1486      my @tmpred_locations = split(",",$thing->tmpred_locations);      my @tmpred_locations = split(",",$thing->tmpred_locations);
1487    
1488        my $phobius_signal_location = $thing->phobius_signal_location;
1489        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1490    
1491      my $lines = [];      my $lines = [];
     my $line_config = { 'title' => 'Localization Evidence',  
                         'short_title' => 'Local',  
                         'basepair_offset' => '1' };  
1492    
1493      #color is      #color is
1494      my $color = "5";      my $color = "6";
1495    
1496      my $line_data = [];  =head3
1497    
1498      if($cello_location){      if($cello_location){
1499          my $cello_descriptions = [];          my $cello_descriptions = [];
1500            my $line_data =[];
1501    
1502            my $line_config = { 'title' => 'Localization Evidence',
1503                                'short_title' => 'CELLO',
1504                                'hover_title' => 'Localization',
1505                                'basepair_offset' => '1' };
1506    
1507          my $description_cello_location = {"title" => 'Best Cello Location',          my $description_cello_location = {"title" => 'Best Cello Location',
1508                                            "value" => $cello_location};                                            "value" => $cello_location};
1509    
# Line 1301  Line 1516 
1516    
1517          my $element_hash = {          my $element_hash = {
1518              "title" => "CELLO",              "title" => "CELLO",
1519                "color"=> $color,
1520              "start" => "1",              "start" => "1",
1521              "end" =>  $length + 1,              "end" =>  $length + 1,
1522              "color"=> $color,              "zlayer" => '1',
             "type" => 'box',  
             "zlayer" => '2',  
1523              "description" => $cello_descriptions};              "description" => $cello_descriptions};
1524    
1525          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
1526            $gd->add_line($line_data, $line_config);
1527      }      }
1528    
1529      my $color = "6";      $color = "2";
     #if(0){  
1530      if($tmpred_score){      if($tmpred_score){
1531            my $line_data =[];
1532            my $line_config = { 'title' => 'Localization Evidence',
1533                                'short_title' => 'Transmembrane',
1534                                'basepair_offset' => '1' };
1535    
1536          foreach my $tmpred (@tmpred_locations){          foreach my $tmpred (@tmpred_locations){
1537              my $descriptions = [];              my $descriptions = [];
1538              my ($begin,$end) =split("-",$tmpred);              my ($begin,$end) =split("-",$tmpred);
# Line 1328  Line 1547 
1547              "end" =>  $end + 1,              "end" =>  $end + 1,
1548              "color"=> $color,              "color"=> $color,
1549              "zlayer" => '5',              "zlayer" => '5',
1550              "type" => 'smallbox',              "type" => 'box',
1551                "description" => $descriptions};
1552    
1553                push(@$line_data,$element_hash);
1554    
1555            }
1556            $gd->add_line($line_data, $line_config);
1557        }
1558    =cut
1559    
1560        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1561            my $line_data =[];
1562            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1563                                'short_title' => 'TM and SP',
1564                                'hover_title' => 'Localization',
1565                                'basepair_offset' => '1' };
1566    
1567            foreach my $tm_loc (@phobius_tm_locations){
1568                my $descriptions = [];
1569                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1570                                 "value" => $tm_loc};
1571                push(@$descriptions,$description_phobius_tm_locations);
1572    
1573                my ($begin,$end) =split("-",$tm_loc);
1574    
1575                my $element_hash = {
1576                "title" => "Phobius",
1577                "start" => $begin + 1,
1578                "end" =>  $end + 1,
1579                "color"=> '6',
1580                "zlayer" => '4',
1581                "type" => 'bigbox',
1582              "description" => $descriptions};              "description" => $descriptions};
1583    
1584              push(@$line_data,$element_hash);              push(@$line_data,$element_hash);
1585    
1586            }
1587    
1588            if($phobius_signal_location){
1589                my $descriptions = [];
1590                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1591                                 "value" => $phobius_signal_location};
1592                push(@$descriptions,$description_phobius_signal_location);
1593    
1594    
1595                my ($begin,$end) =split("-",$phobius_signal_location);
1596                my $element_hash = {
1597                "title" => "phobius signal locations",
1598                "start" => $begin + 1,
1599                "end" =>  $end + 1,
1600                "color"=> '1',
1601                "zlayer" => '5',
1602                "type" => 'box',
1603                "description" => $descriptions};
1604                push(@$line_data,$element_hash);
1605          }          }
1606    
1607            $gd->add_line($line_data, $line_config);
1608      }      }
1609    
1610      my $color = "1";  =head3
1611        $color = "1";
1612      if($signal_peptide_score){      if($signal_peptide_score){
1613            my $line_data = [];
1614          my $descriptions = [];          my $descriptions = [];
1615    
1616            my $line_config = { 'title' => 'Localization Evidence',
1617                                'short_title' => 'SignalP',
1618                                'hover_title' => 'Localization',
1619                                'basepair_offset' => '1' };
1620    
1621          my $description_signal_peptide_score = {"title" => 'signal peptide score',          my $description_signal_peptide_score = {"title" => 'signal peptide score',
1622                                                  "value" => $signal_peptide_score};                                                  "value" => $signal_peptide_score};
1623    
# Line 1351  Line 1631 
1631          my $element_hash = {          my $element_hash = {
1632              "title" => "SignalP",              "title" => "SignalP",
1633              "start" => $cleavage_loc_begin - 2,              "start" => $cleavage_loc_begin - 2,
1634              "end" =>  $cleavage_loc_end + 3,              "end" =>  $cleavage_loc_end + 1,
1635              "type" => 'bigbox',              "type" => 'bigbox',
1636              "color"=> $color,              "color"=> $color,
1637              "zlayer" => '10',              "zlayer" => '10',
1638              "description" => $descriptions};              "description" => $descriptions};
1639    
1640          push(@$line_data,$element_hash);          push(@$line_data,$element_hash);
     }  
   
1641      $gd->add_line($line_data, $line_config);      $gd->add_line($line_data, $line_config);
1642        }
1643    =cut
1644    
1645      return ($gd);      return ($gd);
1646    
# Line 1408  Line 1688 
1688    return $self->{cello_score};    return $self->{cello_score};
1689  }  }
1690    
1691    sub phobius_signal_location {
1692      my ($self) = @_;
1693      return $self->{phobius_signal_location};
1694    }
1695    
1696    sub phobius_tm_locations {
1697      my ($self) = @_;
1698      return $self->{phobius_tm_locations};
1699    }
1700    
1701    
1702    
1703  #########################################  #########################################
1704  #########################################  #########################################
# Line 1421  Line 1712 
1712      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
1713      $self->{identity} = $dataset->{'identity'};      $self->{identity} = $dataset->{'identity'};
1714      $self->{acc} = $dataset->{'acc'};      $self->{acc} = $dataset->{'acc'};
1715        $self->{query} = $dataset->{'query'};
1716      $self->{evalue} = $dataset->{'evalue'};      $self->{evalue} = $dataset->{'evalue'};
1717      $self->{qstart} = $dataset->{'qstart'};      $self->{qstart} = $dataset->{'qstart'};
1718      $self->{qstop} = $dataset->{'qstop'};      $self->{qstop} = $dataset->{'qstop'};
# Line 1438  Line 1730 
1730    
1731  =head3 display()  =head3 display()
1732    
1733  If available use the function specified here to display the "raw" observation.  If available use the function specified here to display a graphical observation.
1734  This code will display a table for the similarities protein  This code will display a graphical view of the similarities using the genome drawer object
   
 B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.  
1735    
1736  =cut  =cut
1737    
1738  sub display {  sub display {
1739      my ($self,$cgi,$dataset) = @_;      my ($self,$gd,$thing,$fig,$base_start,$in_subs,$cgi) = @_;
   
     my $data = [];  
     my $count = 0;  
     my $content;  
     my $fig = new FIG;  
1740    
1741      foreach my $thing (@$dataset) {      # declare variables
1742          my $single_domain = [];      my $window_size = $gd->window_size;
1743          next if ($thing->class ne "SIM");      my $peg = $thing->acc;
1744          $count++;      my $query_id = $thing->query;
1745        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);
1752        my ($org_tax) = ($genome) =~ /(.*)\./;
1753        my $function = $thing->function;
1754        my $query_start = $thing->qstart;
1755        my $query_stop = $thing->qstop;
1756        my $hit_start = $thing->hstart;
1757        my $hit_stop = $thing->hstop;
1758        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        my $query_color = match_color($query_start, $query_stop, abs($query_stop-$query_start), 1);
1763        my $hit_color = match_color($hit_start, $hit_stop, abs($query_stop-$query_start), 1);
1764    
1765        my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1766    
1767        # hit sequence title
1768        my $line_config = { 'title' => "$organism [$org_tax]",
1769                            'short_title' => "$abbrev_name",
1770                            'title_link' => '$tax_link',
1771                            'basepair_offset' => '0',
1772                            'no_middle_line' => '1'
1773                            };
1774    
1775          my $id = $thing->acc;      # query sequence title
1776        my $replace_id = $peg;
1777        $replace_id =~ s/\|/_/ig;
1778        my $anchor_name = "anchor_". $replace_id;
1779        my $query_config = { 'title' => "Query",
1780                             'short_title' => "Query",
1781                             'title_link' => "changeSimsLocation('$replace_id', 1)",
1782                             'basepair_offset' => '0',
1783                             'no_middle_line' => '1'
1784                             };
1785        my $line_data = [];
1786        my $query_data = [];
1787    
1788          # add the subsystem information      my $element_hash;
1789          my @in_sub  = $fig->peg_to_subsystems($id);      my $hit_links_list = [];
1790          my $in_sub;      my $hit_descriptions = [];
1791        my $query_descriptions = [];
1792    
1793        # get sequence information
1794        # evidence link
1795        my $evidence_link;
1796        if ($peg =~ /^fig\|/){
1797          $evidence_link = "?page=Evidence&feature=".$peg;
1798        }
1799        else{
1800          my $db = &Observation::get_database($peg);
1801          my ($link_id) = ($peg) =~ /\|(.*)/;
1802          $evidence_link = &HTML::alias_url($link_id, $db);
1803          #print STDERR "LINK: $db    $evidence_link";
1804        }
1805        my $link = {"link_title" => $peg,
1806                    "link" => $evidence_link};
1807        push(@$hit_links_list,$link) if ($evidence_link);
1808    
1809        # subsystem link
1810        my $subs = $in_subs->{$peg} if (defined $in_subs->{$peg});
1811        my @subsystems;
1812        foreach my $array (@$subs){
1813            my $subsystem = $$array[0];
1814            push(@subsystems,$subsystem);
1815            my $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
1816                        "link_title" => $subsystem};
1817            push(@$hit_links_list,$link);
1818        }
1819    
1820        # blast alignment
1821        $link = {"link_title" => "view blast alignment",
1822                 "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query_id&peg2=$peg"};
1823        push (@$hit_links_list,$link) if ($peg =~ /^fig\|/);
1824    
1825          if (@in_sub > 0) {      # description data
1826              $in_sub = @in_sub;      my $description_function;
1827        $description_function = {"title" => "function",
1828                                 "value" => $function};
1829        push(@$hit_descriptions,$description_function);
1830    
1831        # subsystem description
1832        my $ss_string = join (",", @subsystems);
1833        $ss_string =~ s/_/ /ig;
1834        my $description_ss = {"title" => "subsystems",
1835                              "value" => $ss_string};
1836        push(@$hit_descriptions,$description_ss);
1837    
1838        # location description
1839        # hit
1840        my $description_loc;
1841        $description_loc = {"title" => "Hit Location",
1842                            "value" => $hit_start . " - " . $hit_stop};
1843        push(@$hit_descriptions, $description_loc);
1844    
1845        $description_loc = {"title" => "Sequence Length",
1846                            "value" => $ln_hit};
1847        push(@$hit_descriptions, $description_loc);
1848    
1849        # query
1850        $description_loc = {"title" => "Hit Location",
1851                            "value" => $query_start . " - " . $query_stop};
1852        push(@$query_descriptions, $description_loc);
1853    
1854        $description_loc = {"title" => "Sequence Length",
1855                            "value" => $ln_query};
1856        push(@$query_descriptions, $description_loc);
1857    
             # RAE: add a javascript popup with all the subsystems  
             my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub;  
             $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub);  
         } else {  
             $in_sub = "&nbsp;";  
         }  
1858    
         # add evidence code with tool tip  
         my $ev_codes=" &nbsp; ";  
         my @ev_codes = "";  
         if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {  
             my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($id);  
             @ev_codes = ();  
             foreach my $code (@codes) {  
                 my $pretty_code = $code->[2];  
                 if ($pretty_code =~ /;/) {  
                     my ($cd, $ss) = split(";", $code->[2]);  
                     $ss =~ s/_/ /g;  
                     $pretty_code = $cd;# . " in " . $ss;  
                 }  
                 push(@ev_codes, $pretty_code);  
             }  
         }  
1859    
1860          if (scalar(@ev_codes) && $ev_codes[0]) {      # evalue score description
1861              my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);      my $evalue = $thing->evalue;
1862              $ev_codes = $cgi->a(      while ($evalue =~ /-0/)
1863                                  {                                  {
1864                                      id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));          my ($chunk1, $chunk2) = split(/-/, $evalue);
1865          }          $chunk2 = substr($chunk2,1);
1866            $evalue = $chunk1 . "-" . $chunk2;
1867        }
1868    
1869        my $color = &color($evalue);
1870        my $description_eval = {"title" => "E-Value",
1871                                "value" => $evalue};
1872        push(@$hit_descriptions, $description_eval);
1873        push(@$query_descriptions, $description_eval);
1874    
1875        my $identity = $self->identity;
1876        my $description_identity = {"title" => "Identity",
1877                                    "value" => $identity};
1878        push(@$hit_descriptions, $description_identity);
1879        push(@$query_descriptions, $description_identity);
1880    
         # add the aliases  
         my $aliases = undef;  
         $aliases = &html_enc( join( ", ", $fig->feature_aliases($id) ) );  
         $aliases = &HTML::set_prot_links( $cgi, $aliases );  
         $aliases ||= "&nbsp;";  
   
         my $iden    = $thing->identity;  
         my $ln1     = $thing->qlength;  
         my $ln2     = $thing->hlength;  
         my $b1      = $thing->qstart;  
         my $e1      = $thing->qstop;  
         my $b2      = $thing->hstart;  
         my $e2      = $thing->hstop;  
         my $d1      = abs($e1 - $b1) + 1;  
         my $d2      = abs($e2 - $b2) + 1;  
         my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
         my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
1881    
1882        my $number = $base_start + ($query_start-$hit_start);
1883        #print STDERR "START: $number";
1884        $element_hash = {
1885            "title" => $query_id,
1886            "start" => $base_start,
1887            "end" => $base_start+$ln_query,
1888            "type"=> 'box',
1889            "color"=> $color,
1890            "zlayer" => "2",
1891            "links_list" => $query_links_list,
1892            "description" => $query_descriptions
1893            };
1894        push(@$query_data,$element_hash);
1895    
1896          push(@$single_domain,$thing->database);      $element_hash = {
1897          push(@$single_domain,&HTML::set_prot_links($cgi,$thing->acc));          "title" => $query_id . ': HIT AREA',
1898          push(@$single_domain,$thing->evalue);          "start" => $base_start + $query_start,
1899          push(@$single_domain,"$iden\%");          "end" =>  $base_start + $query_stop,
1900          push(@$single_domain,$reg1);          "type"=> 'smallbox',
1901          push(@$single_domain,$reg2);          "color"=> $query_color,
1902          push(@$single_domain,$in_sub);          "zlayer" => "3",
1903          push(@$single_domain,$ev_codes);          "links_list" => $query_links_list,
1904          push(@$single_domain,$thing->organism);          "description" => $query_descriptions
1905          push(@$single_domain,$thing->function);          };
1906          push(@$single_domain,$aliases);      push(@$query_data,$element_hash);
         push(@$data,$single_domain);  
     }  
1907    
1908      if ($count >0){      $gd->add_line($query_data, $query_config);
1909          $content = $data;  
1910      }  
1911      else      $element_hash = {
1912      {                  "title" => $peg,
1913                    "start" => $base_start + ($query_start-$hit_start),
1914                    "end" => $base_start + (($query_start-$hit_start)+$ln_hit),
1915                    "type"=> 'box',
1916                    "color"=> $color,
1917                    "zlayer" => "2",
1918                    "links_list" => $hit_links_list,
1919                    "description" => $hit_descriptions
1920                    };
1921        push(@$line_data,$element_hash);
1922    
1923        $element_hash = {
1924            "title" => $peg . ': HIT AREA',
1925            "start" => $base_start + $query_start,
1926            "end" =>  $base_start + $query_stop,
1927            "type"=> 'smallbox',
1928            "color"=> $hit_color,
1929            "zlayer" => "3",
1930            "links_list" => $hit_links_list,
1931            "description" => $hit_descriptions
1932            };
1933        push(@$line_data,$element_hash);
1934    
1935        $gd->add_line($line_data, $line_config);
1936    
1937        my $breaker = [];
1938        my $breaker_hash = {};
1939        my $breaker_config = { 'no_middle_line' => "1" };
1940    
1941        push (@$breaker, $breaker_hash);
1942        $gd->add_line($breaker, $breaker_config);
1943    
1944        return ($gd);
1945    }
1946    
1947    =head3 display_domain_composition()
1948    
1949    If available use the function specified here to display a graphical observation of the CDD(later Pfam or selected) domains that occur in the set of similar proteins
1950    
1951    =cut
1952    
1953    sub display_domain_composition {
1954        my ($self,$gd,$fig) = @_;
1955    
1956        #$fig = new FIG;
1957        my $peg = $self->acc;
1958    
1959        my $line_data = [];
1960        my $links_list = [];
1961        my $descriptions = [];
1962    
1963        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1964        #my @domain_query_results = ();
1965        foreach $dqr (@domain_query_results){
1966            my $key = @$dqr[1];
1967            my @parts = split("::",$key);
1968            my $db = $parts[0];
1969            my $id = $parts[1];
1970            my $val = @$dqr[2];
1971            my $from;
1972            my $to;
1973            my $evalue;
1974    
1975            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1976                my $raw_evalue = $1;
1977                $from = $2;
1978                $to = $3;
1979                if($raw_evalue =~/(\d+)\.(\d+)/){
1980                    my $part2 = 1000 - $1;
1981                    my $part1 = $2/100;
1982                    $evalue = $part1."e-".$part2;
1983                }
1984                else{
1985                    $evalue = "0.0";
1986                }
1987            }
1988    
1989            my $dbmaster = DBMaster->new(-database =>'Ontology',
1990                                    -host     => $WebConfig::DBHOST,
1991                                    -user     => $WebConfig::DBUSER,
1992                                    -password => $WebConfig::DBPWD);
1993            my ($name_value,$description_value);
1994    
1995            if($db eq "CDD"){
1996                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1997                if(!scalar(@$cdd_objs)){
1998                    $name_title = "name";
1999                    $name_value = "not available";
2000                    $description_title = "description";
2001                    $description_value = "not available";
2002                }
2003                else{
2004                    my $cdd_obj = $cdd_objs->[0];
2005                    $name_value = $cdd_obj->term;
2006                    $description_value = $cdd_obj->description;
2007                }
2008            }
2009    
2010            my $domain_name;
2011            $domain_name = {"title" => "name",
2012                            "value" => $name_value};
2013            push(@$descriptions,$domain_name);
2014    
2015            my $description;
2016            $description = {"title" => "description",
2017                            "value" => $description_value};
2018            push(@$descriptions,$description);
2019    
2020            my $score;
2021            $score = {"title" => "score",
2022                      "value" => $evalue};
2023            push(@$descriptions,$score);
2024    
2025            my $link_id = $id;
2026            my $link;
2027            my $link_url;
2028            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"}
2029            elsif($db eq "PFAM"){$link_url = "http://pfam.sanger.ac.uk/family?acc=$link_id"}
2030            else{$link_url = "NO_URL"}
2031    
2032            $link = {"link_title" => $name_value,
2033                     "link" => $link_url};
2034            push(@$links_list,$link);
2035    
2036            my $domain_element_hash = {
2037                "title" => $peg,
2038                "start" => $from,
2039                "end" =>  $to,
2040                "type"=> 'box',
2041                "zlayer" => '4',
2042                "links_list" => $links_list,
2043                "description" => $descriptions
2044                };
2045    
2046            push(@$line_data,$domain_element_hash);
2047    
2048            #just one CDD domain for now, later will add option for multiple domains from selected DB
2049            last;
2050        }
2051    
2052        my $line_config = { 'title' => $peg,
2053                            'hover_title' => 'Domain',
2054                            'short_title' => $peg,
2055                            'basepair_offset' => '1' };
2056    
2057        $gd->add_line($line_data, $line_config);
2058    
2059        return ($gd);
2060    
2061    }
2062    
2063    =head3 display_table()
2064    
2065    If available use the function specified here to display the "raw" observation.
2066    This code will display a table for the similarities protein
2067    
2068    B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence.
2069    
2070    =cut
2071    
2072    sub display_table {
2073        my ($self,$dataset, $show_columns, $query_fid, $fig, $application, $cgi) = @_;
2074        my ($count, $data, $content, %box_column, $subsystems_column, $evidence_column, %e_identical, $function_color, @ids);
2075    
2076        my $scroll_list;
2077        foreach my $col (@$show_columns){
2078            push (@$scroll_list, $col->{key});
2079        }
2080    
2081        push (@ids, $query_fid);
2082        foreach my $thing (@$dataset) {
2083            next if ($thing->class ne "SIM");
2084            push (@ids, $thing->acc);
2085        }
2086    
2087        $lineages = $fig->taxonomy_list() if (grep /lineage/, @$scroll_list);
2088        my @attributes = $fig->get_attributes(\@ids) if ( (grep /evidence/, @$scroll_list) || (grep /(pfam|mw)/, @$scroll_list) );
2089    
2090        # get the column for the subsystems
2091        $subsystems_column = &get_subsystems_column(\@ids,$fig,$cgi,'hash') if (grep /subsystem/, @$scroll_list);
2092    
2093        # get the column for the evidence codes
2094        $evidence_column = &get_evidence_column(\@ids, \@attributes, $fig, $cgi, 'hash') if (grep /^evidence$/, @$scroll_list);
2095    
2096        # get the column for pfam_domain
2097        $pfam_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'pfam', 'PFAM', 'hash') if (grep /^pfam$/, @$scroll_list);
2098    
2099        # get the column for molecular weight
2100        $mw_column = &get_attrb_column(\@ids, \@attributes, $fig, $cgi, 'mw', 'molecular_weight', 'hash') if (grep /^mw$/, @$scroll_list);
2101    
2102        # get the column for organism's habitat
2103        my $habitat_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'habitat', 'Habitat', 'hash') if (grep /^habitat$/, @$scroll_list);
2104    
2105        # get the column for organism's temperature optimum
2106        my $temperature_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temperature', 'Optimal_Temperature', 'hash') if (grep /^temperature$/, @$scroll_list);
2107    
2108        # get the column for organism's temperature range
2109        my $temperature_range_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'temp_range', 'Temperature_Range', 'hash') if (grep /^temp_range$/, @$scroll_list);
2110    
2111        # get the column for organism's oxygen requirement
2112        my $oxygen_req_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'oxygen', 'Oxygen_Requirement', 'hash') if (grep /^oxygen$/, @$scroll_list);
2113    
2114        # get the column for organism's pathogenicity
2115        my $pathogenic_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic', 'Pathogenic', 'hash') if (grep /^pathogenic$/, @$scroll_list);
2116    
2117        # get the column for organism's pathogenicity host
2118        my $pathogenic_in_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'pathogenic_in', 'Pathogenic_In', 'hash') if (grep /^pathogenic_in$/, @$scroll_list);
2119    
2120        # get the column for organism's salinity
2121        my $salinity_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'salinity', 'Salinity', 'hash') if (grep /^salinity$/, @$scroll_list);
2122    
2123        # get the column for organism's motility
2124        my $motility_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'motility', 'Motility', 'hash') if (grep /^motility$/, @$scroll_list);
2125    
2126        # get the column for organism's gram stain
2127        my $gram_stain_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gram_stain', 'Gram_Stain', 'hash') if (grep /^gram_stain$/, @$scroll_list);
2128    
2129        # get the column for organism's endospores
2130        my $endospores_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'endospores', 'Endospores', 'hash') if (grep /^endospores$/, @$scroll_list);
2131    
2132        # get the column for organism's shape
2133        my $shape_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'shape', 'Shape', 'hash') if (grep /^shape$/, @$scroll_list);
2134    
2135        # get the column for organism's disease
2136        my $disease_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'disease', 'Disease', 'hash') if (grep /^disease$/, @$scroll_list);
2137    
2138        # get the column for organism's disease
2139        my $gc_content_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'gc_content', 'GC_Content', 'hash') if (grep /^gc_content$/, @$scroll_list);
2140    
2141        # get the column for transmembrane domains
2142        my $transmembrane_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'transmembrane', 'Phobius::transmembrane', 'hash') if (grep /^transmembrane$/, @$scroll_list);
2143    
2144        # get the column for similar to human
2145        my $similar_to_human_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'similar_to_human', 'similar_to_human', 'hash') if (grep /^similar_to_human$/, @$scroll_list);
2146    
2147        # get the column for signal peptide
2148        my $signal_peptide_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'signal_peptide', 'Phobius::signal', 'hash') if (grep /^signal_peptide$/, @$scroll_list);
2149    
2150        # get the column for transmembrane domains
2151        my $isoelectric_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'isoelectric', 'isoelectric_point', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2152    
2153        # get the column for conserved neighborhood
2154        my $cons_neigh_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'conserved_neighborhood', undef, 'hash') if (grep /^conserved_neighborhood$/, @$scroll_list);
2155    
2156        # get the column for cellular location
2157        my $cell_location_column = &get_attrb_column(\@ids, undef, $fig, $cgi, 'cellular_location', 'PSORT::', 'hash') if (grep /^isoelectric$/, @$scroll_list);
2158    
2159        # get the aliases
2160        my $alias_col;
2161        if ( (grep /asap_id/, @$scroll_list) || (grep /ncbi_id/, @$scroll_list) ||
2162             (grep /refseq_id/, @$scroll_list) || (grep /swissprot_id/, @$scroll_list) ||
2163             (grep /uniprot_id/, @$scroll_list) || (grep /tigr_id/, @$scroll_list) ||
2164             (grep /kegg_id/, @$scroll_list) || (grep /pir_id/, @$scroll_list) ||
2165             (grep /trembl_id/, @$scroll_list) || (grep /jgi_id/, @$scroll_list) ) {
2166            $alias_col = &get_db_aliases(\@ids,$fig,'all',$cgi,'hash');
2167        }
2168    
2169        # get the colors for the function cell
2170        my $functions = $fig->function_of_bulk(\@ids,1);
2171        $functional_color = &get_function_color_cell($functions, $fig);
2172        my $query_function = $fig->function_of($query_fid);
2173    
2174        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
2175    
2176        my $figfam_data = &FIG::get_figfams_data();
2177        my $figfams = new FFs($figfam_data);
2178    
2179        my $func_color_offset=0;
2180        unshift(@$dataset, $query_fid);
2181        foreach my $thing ( @$dataset){
2182            my ($id, $taxid, $iden, $ln1,$ln2,$b1,$b2,$e1,$e2,$d1,$d2,$color1,$color2,$reg1,$reg2);
2183            if ($thing eq $query_fid){
2184                $id = $thing;
2185                $taxid   = $fig->genome_of($id);
2186                $organism = $fig->genus_species($taxid);
2187                $current_function = $fig->function_of($id);
2188            }
2189            else{
2190                next if ($thing->class ne "SIM");
2191    
2192                $id      = $thing->acc;
2193                $evalue  = $thing->evalue;
2194                $taxid   = $fig->genome_of($id);
2195                $iden    = $thing->identity;
2196                $organism= $thing->organism;
2197                $ln1     = $thing->qlength;
2198                $ln2     = $thing->hlength;
2199                $b1      = $thing->qstart;
2200                $e1      = $thing->qstop;
2201                $b2      = $thing->hstart;
2202                $e2      = $thing->hstop;
2203                $d1      = abs($e1 - $b1) + 1;
2204                $d2      = abs($e2 - $b2) + 1;
2205                $color1  = match_color( $b1, $e1, $ln1 );
2206                $color2  = match_color( $b2, $e2, $ln2 );
2207                $reg1    = {'data'=> "$b1-$e1 (<b>$d1/$ln1</b>)", 'highlight' => $color1};
2208                $reg2    = {'data'=> "$b2-$e2 (<b>$d2/$ln2</b>)", 'highlight' => $color2};
2209                $current_function = $thing->function;
2210            }
2211    
2212            my $single_domain = [];
2213            $count++;
2214    
2215            # organisms cell
2216            my ($org, $org_color) = $fig->org_and_color_of($id);
2217            my $org_cell = { 'data' =>  $organism, 'highlight' => $org_color};
2218    
2219            # checkbox cell
2220            my ($box_cell,$tax, $radio_cell);
2221            my $field_name = "tables_" . $id;
2222            my $pair_name = "visual_" . $id;
2223            my $cell_name = "cell_". $id;
2224            my $replace_id = $id;
2225            $replace_id =~ s/\|/_/ig;
2226            my $white = '#ffffff';
2227            $white = '#999966' if ($id eq $query_fid);
2228            $org_color = '#999966' if ($id eq $query_fid);
2229            my $anchor_name = "anchor_". $replace_id;
2230            if ($id =~ /^fig\|/){
2231              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');">);
2232              my $radio = qq(<input type="radio" name="function_select" value="$id" id="$field_name" >);
2233              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2234              $radio_cell = { 'data'=>$radio, 'highlight'=>$white};
2235              $tax = $fig->genome_of($id);
2236            }
2237            else{
2238              my $box = qq(<a name="$anchor_name"></a>);
2239              $box_cell = { 'data'=>$box, 'highlight'=>$org_color};
2240            }
2241    
2242            # get the linked fig id
2243            my $anchor_link = "graph_" . $replace_id;
2244            my $fig_data =  "<table><tr><td>" . &HTML::set_prot_links($cgi,$id) . "</td>" . "&nbsp;" x 2;
2245            $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>);
2246            my $fig_col = {'data'=> $fig_data,
2247                           'highlight'=>$white};
2248    
2249            $replace_id = $peg;
2250            $replace_id =~ s/\|/_/ig;
2251            $anchor_name = "anchor_". $replace_id;
2252            my $query_config = { 'title' => "Query",
2253                                 'short_title' => "Query",
2254                                 'title_link' => "changeSimsLocation('$replace_id')",
2255                                 'basepair_offset' => '0'
2256                                 };
2257    
2258            # function cell
2259            my $function_cell_colors = {0=>"#ffffff", 1=>"#eeccaa", 2=>"#ffaaaa",
2260                                        3=>"#ffcc66", 4=>"#ffff00", 5=>"#aaffaa",
2261                                        6=>"#bbbbff", 7=>"#ffaaff", 8=>"#dddddd"};
2262    
2263            my $function_color;
2264            if ( (defined($functional_color->{$query_function})) && ($functional_color->{$query_function} == 1) ){
2265                $function_color = $function_cell_colors->{ $functional_color->{$current_function} - $func_color_offset};
2266            }
2267            else{
2268                $function_color = $function_cell_colors->{ $functional_color->{$current_function}};
2269            }
2270            my $function_cell;
2271            if ($current_function){
2272              if ($current_function eq $query_function){
2273                $function_cell = {'data'=>$current_function, 'highlight'=>$function_cell_colors->{0}};
2274                $func_color_offset=1;
2275              }
2276              else{
2277                  $function_cell = {'data'=>$current_function,'highlight' => $function_color};
2278              }
2279            }
2280            else{
2281              $function_cell = {'data'=>$current_function,'highlight' => "#dddddd"};
2282            }
2283    
2284            if ($id eq $query_fid){
2285                push (@$single_domain, $box_cell, {'data'=>qq~<i>Query Sequence: </i>~  . qq~<b>$id</b>~ , 'highlight'=>$white}, {'data'=> 'n/a', 'highlight'=>$white},
2286                      {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white}, {'data'=>'n/a', 'highlight'=>$white},
2287                      {'data' =>  $organism, 'highlight'=> $white}, {'data'=>$current_function, 'highlight'=>$white});  # permanent columns
2288            }
2289            else{
2290                push (@$single_domain, $box_cell, $fig_col, {'data'=> $evalue, 'highlight'=>"#ffffff"},
2291                      {'data'=>"$iden\%", 'highlight'=>"#ffffff"}, $reg1, $reg2, $org_cell, $function_cell);  # permanent columns
2292            }
2293    
2294            if ( ( $application->session->user) ){
2295                if ( ($application->session->user->login) && ($application->session->user->login eq "arodri")){
2296                    push (@$single_domain,$radio_cell);
2297                }
2298            }
2299    
2300            my ($ff) = $figfams->families_containing_peg($id);
2301    
2302            foreach my $col (@$scroll_list){
2303                if ($id eq $query_fid) { $highlight_color = "#999966"; }
2304                else { $highlight_color = "#ffffff"; }
2305    
2306                if ($col =~ /subsystem/)                     {push(@$single_domain,{'data'=>$subsystems_column->{$id},'highlight'=>$highlight_color});}
2307                elsif ($col =~ /evidence/)                   {push(@$single_domain,{'data'=>$evidence_column->{$id},'highlight'=>$highlight_color});}
2308                elsif ($col =~ /pfam/)                       {push(@$single_domain,{'data'=>$pfam_column->{$id},'highlight'=>$highlight_color});}
2309                elsif ($col =~ /mw/)                         {push(@$single_domain,{'data'=>$mw_column->{$id},'highlight'=>$highlight_color});}
2310                elsif ($col =~ /habitat/)                    {push(@$single_domain,{'data'=>$habitat_column->{$id},'highlight'=>$highlight_color});}
2311                elsif ($col =~ /temperature/)                {push(@$single_domain,{'data'=>$temperature_column->{$id},'highlight'=>$highlight_color});}
2312                elsif ($col =~ /temp_range/)                 {push(@$single_domain,{'data'=>$temperature_range_column->{$id},'highlight'=>$highlight_color});}
2313                elsif ($col =~ /oxygen/)                     {push(@$single_domain,{'data'=>$oxygen_req_column->{$id},'highlight'=>$highlight_color});}
2314                elsif ($col =~ /^pathogenic$/)               {push(@$single_domain,{'data'=>$pathogenic_column->{$id},'highlight'=>$highlight_color});}
2315                elsif ($col =~ /^pathogenic_in$/)            {push(@$single_domain,{'data'=>$pathogenic_in_column->{$id},'highlight'=>$highlight_color});}
2316                elsif ($col =~ /salinity/)                   {push(@$single_domain,{'data'=>$salinity_column->{$id},'highlight'=>$highlight_color});}
2317                elsif ($col =~ /motility/)                   {push(@$single_domain,{'data'=>$motility_column->{$id},'highlight'=>$highlight_color});}
2318                elsif ($col =~ /gram_stain/)                 {push(@$single_domain,{'data'=>$gram_stain_column->{$id},'highlight'=>$highlight_color});}
2319                elsif ($col =~ /endospores/)                 {push(@$single_domain,{'data'=>$endospores_column->{$id},'highlight'=>$highlight_color});}
2320                elsif ($col =~ /shape/)                      {push(@$single_domain,{'data'=>$shape_column->{$id},'highlight'=>$highlight_color});}
2321                elsif ($col =~ /disease/)                    {push(@$single_domain,{'data'=>$disease_column->{$id},'highlight'=>$highlight_color});}
2322                elsif ($col =~ /gc_content/)                 {push(@$single_domain,{'data'=>$gc_content_column->{$id},'highlight'=>$highlight_color});}
2323                elsif ($col =~ /transmembrane/)              {push(@$single_domain,{'data'=>$transmembrane_column->{$id},'highlight'=>$highlight_color});}
2324                elsif ($col =~ /signal_peptide/)             {push(@$single_domain,{'data'=>$signal_peptide_column->{$id},'highlight'=>$highlight_color});}
2325                elsif ($col =~ /isoelectric/)                {push(@$single_domain,{'data'=>$isoelectric_column->{$id},'highlight'=>$highlight_color});}
2326                elsif ($col =~ /conserved_neighborhood/)     {push(@$single_domain,{'data'=>$cons_neigh_column->{$id},'highlight'=>$highlight_color});}
2327                elsif ($col =~ /cellular_location/)          {push(@$single_domain,{'data'=>$cell_location_column->{$id},'highlight'=>$highlight_color});}
2328                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"NCBI"},'highlight'=>$highlight_color});}
2329                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"RefSeq"},'highlight'=>$highlight_color});}
2330                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,{'data'=>$alias_col->{$id}->{"SwissProt"},'highlight'=>$highlight_color});}
2331                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,{'data'=>$alias_col->{$id}->{"UniProt"},'highlight'=>$highlight_color});}
2332                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TIGR"},'highlight'=>$highlight_color});}
2333                elsif ($col =~ /pir_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"PIR"},'highlight'=>$highlight_color});}
2334                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"KEGG"},'highlight'=>$highlight_color});}
2335                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,{'data'=>$alias_col->{$id}->{"TrEMBL"},'highlight'=>$highlight_color});}
2336                elsif ($col =~ /asap_id/)                    {push(@$single_domain,{'data'=>$alias_col->{$id}->{"ASAP"},'highlight'=>$highlight_color});}
2337                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,{'data'=>$alias_col->{$id}->{"JGI"},'highlight'=>$highlight_color});}
2338                elsif ($col =~ /lineage/)                   {push(@$single_domain,{'data'=>$lineages->{$tax},'highlight'=>$highlight_color});}
2339                elsif ($col =~ /figfam/)                     {push(@$single_domain,{'data'=>"<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>",'highlight'=>$highlight_color});}
2340            }
2341            push(@$data,$single_domain);
2342        }
2343        if ($count >0 ){
2344            $content = $data;
2345        }
2346        else{
2347          $content = "<p>This PEG does not have any similarities</p>";          $content = "<p>This PEG does not have any similarities</p>";
2348      }      }
2349        shift(@$dataset);
2350      return ($content);      return ($content);
2351  }  }
2352    
2353    sub get_box_column{
2354        my ($ids) = @_;
2355        my %column;
2356        foreach my $id (@$ids){
2357            my $field_name = "tables_" . $id;
2358            my $pair_name = "visual_" . $id;
2359            my $cell_name = "cell_" . $id;
2360            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name', '$cell_name');">);
2361        }
2362        return (%column);
2363    }
2364    
2365    sub get_figfam_column{
2366        my ($ids, $fig, $cgi) = @_;
2367        my $column;
2368    
2369        my $figfam_data = &FIG::get_figfams_data();
2370        my $figfams = new FFs($figfam_data);
2371    
2372        foreach my $id (@$ids){
2373            my ($ff) =  $figfams->families_containing_peg($id);
2374            if ($ff){
2375                push (@$column, "<a href='?page=FigFamViewer&figfam=" . $ff . "' target='_new'>" . $ff . "</a>");
2376            }
2377            else{
2378                push (@$column, " ");
2379            }
2380        }
2381    
2382        return $column;
2383    }
2384    
2385    sub get_subsystems_column{
2386        my ($ids,$fig,$cgi,$returnType) = @_;
2387    
2388        my %in_subs  = $fig->subsystems_for_pegs($ids);
2389        my ($column, $ss);
2390        foreach my $id (@$ids){
2391            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
2392            my @subsystems;
2393    
2394            if (@in_sub > 0) {
2395                foreach my $array(@in_sub){
2396                    my $ss = $array->[0];
2397                    $ss =~ s/_/ /ig;
2398                    push (@subsystems, "-" . $ss);
2399                }
2400                my $in_sub_line = join ("<br>", @subsystems);
2401                $ss->{$id} = $in_sub_line;
2402            } else {
2403                $ss->{$id} = "None added";
2404            }
2405            push (@$column, $ss->{$id});
2406        }
2407    
2408        if ($returnType eq 'hash') { return $ss; }
2409        elsif ($returnType eq 'array') { return $column; }
2410    }
2411    
2412    sub get_lineage_column{
2413        my ($ids, $fig, $cgi) = @_;
2414    
2415        my $lineages = $fig->taxonomy_list();
2416    
2417        foreach my $id (@$ids){
2418            my $genome = $fig->genome_of($id);
2419            if ($lineages->{$genome}){
2420    #           push (@$column, qq~<table style='border-style:hidden;'><tr><td style='background-color: #ffffff;'>~ . $lineages->{$genome} . qq~</td></tr</table>~);
2421                push (@$column, $lineages->{$genome});
2422            }
2423            else{
2424                push (@$column, " ");
2425            }
2426        }
2427        return $column;
2428    }
2429    
2430    sub match_color {
2431        my ( $b, $e, $n , $rgb) = @_;
2432        my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
2433        my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
2434        my $cov = ( $r - $l + 1 ) / $n;
2435        my $sat = 1 - 10 * $cov / 9;
2436        my $br  = 1;
2437        if ($rgb){
2438            return html2rgb( rgb2html( hsb2rgb( $hue, $sat, $br ) ) );
2439        }
2440        else{
2441            rgb2html( hsb2rgb( $hue, $sat, $br ) );
2442        }
2443    }
2444    
2445    sub hsb2rgb {
2446        my ( $h, $s, $br ) = @_;
2447        $h = 6 * ($h - floor($h));
2448        if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
2449        if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
2450        my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
2451                                          : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
2452                                          :               ( 0,      1,      $h - 2 )
2453                                          )
2454                                        : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
2455                                          : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
2456                                          :               ( 1,      0,      6 - $h )
2457                                          );
2458        ( ( $r * $s + 1 - $s ) * $br,
2459          ( $g * $s + 1 - $s ) * $br,
2460          ( $b * $s + 1 - $s ) * $br
2461        )
2462    }
2463    
2464    sub html2rgb {
2465        my ($hex) = @_;
2466        my ($r,$g,$b) = ($hex) =~ /^\#(\w\w)(\w\w)(\w\w)/;
2467        my $code = { 'A'=>10, 'B'=>11, 'C'=>12, 'D'=>13, 'E'=>14, 'F'=>15,
2468                     1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9};
2469    
2470        my @R = split(//, $r);
2471        my @G = split(//, $g);
2472        my @B = split(//, $b);
2473    
2474        my $red = ($code->{uc($R[0])}*16)+$code->{uc($R[1])};
2475        my $green = ($code->{uc($G[0])}*16)+$code->{uc($G[1])};
2476        my $blue = ($code->{uc($B[0])}*16)+$code->{uc($B[1])};
2477    
2478        my $rgb = [$red, $green, $blue];
2479        return $rgb;
2480    
2481    }
2482    
2483    sub rgb2html {
2484        my ( $r, $g, $b ) = @_;
2485        if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
2486        if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
2487        if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
2488        sprintf("#%02x%02x%02x", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
2489    }
2490    
2491    sub floor {
2492        my $x = $_[0];
2493        defined( $x ) || return undef;
2494        ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
2495    }
2496    
2497    sub get_function_color_cell{
2498      my ($functions, $fig) = @_;
2499    
2500      # figure out the quantity of each function
2501      my %hash;
2502      foreach my $key (keys %$functions){
2503        my $func = $functions->{$key};
2504        $hash{$func}++;
2505      }
2506    
2507      my %func_colors;
2508      my $count = 1;
2509      foreach my $key (sort {$hash{$b}<=>$hash{$a}} keys %hash){
2510        $func_colors{$key}=$count;
2511        $count++;
2512      }
2513    
2514      return \%func_colors;
2515    }
2516    
2517    sub get_essentially_identical{
2518        my ($fid,$dataset,$fig) = @_;
2519        #my $fig = new FIG;
2520    
2521        my %id_list;
2522        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2523    
2524        foreach my $thing (@$dataset){
2525            if($thing->class eq "IDENTICAL"){
2526                my $rows = $thing->rows;
2527                my $count_identical = 0;
2528                foreach my $row (@$rows) {
2529                    my $id = $row->[0];
2530                    if (($id ne $fid) && ($fig->function_of($id))) {
2531                        $id_list{$id} = 1;
2532                    }
2533                }
2534            }
2535        }
2536    
2537    #    foreach my $id (@maps_to) {
2538    #        if (($id ne $fid) && ($fig->function_of($id))) {
2539    #           $id_list{$id} = 1;
2540    #        }
2541    #    }
2542        return(%id_list);
2543    }
2544    
2545    
2546    sub get_evidence_column{
2547        my ($ids,$attributes,$fig,$cgi,$returnType) = @_;
2548        my ($column, $code_attributes);
2549    
2550        if (! defined $attributes) {
2551            my @attributes_array = $fig->get_attributes($ids);
2552            $attributes = \@attributes_array;
2553        }
2554    
2555        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2556        foreach my $key (@codes){
2557            push (@{$code_attributes->{$key->[0]}}, $key);
2558        }
2559    
2560        foreach my $id (@$ids){
2561            # add evidence code with tool tip
2562            my $ev_codes=" &nbsp; ";
2563    
2564            my @codes = @{$code_attributes->{$id}} if (defined @{$code_attributes->{$id}});
2565            my @ev_codes = ();
2566            foreach my $code (@codes) {
2567                my $pretty_code = $code->[2];
2568                if ($pretty_code =~ /;/) {
2569                    my ($cd, $ss) = split(";", $code->[2]);
2570                    $ss =~ s/_/ /g;
2571                    $pretty_code = $cd;# . " in " . $ss;
2572                }
2573                push(@ev_codes, $pretty_code);
2574            }
2575    
2576            if (scalar(@ev_codes) && $ev_codes[0]) {
2577                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2578                $ev_codes = $cgi->a(
2579                                    {
2580                                        id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes));
2581            }
2582    
2583            if ($returnType eq 'hash') { $column->{$id}=$ev_codes; }
2584            elsif ($returnType eq 'array') { push (@$column, $ev_codes); }
2585        }
2586        return $column;
2587    }
2588    
2589    sub get_attrb_column{
2590        my ($ids, $attributes, $fig, $cgi, $colName, $attrbName, $returnType) = @_;
2591    
2592        my ($column, %code_attributes, %attribute_locations);
2593        my $dbmaster = DBMaster->new(-database =>'Ontology',
2594                                     -host     => $WebConfig::DBHOST,
2595                                     -user     => $WebConfig::DBUSER,
2596                                     -password => $WebConfig::DBPWD);
2597    
2598        if ($colName eq "pfam"){
2599            if (! defined $attributes) {
2600                my @attributes_array = $fig->get_attributes($ids);
2601                $attributes = \@attributes_array;
2602            }
2603    
2604            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2605            foreach my $key (@codes){
2606                my $name = $key->[1];
2607                if ($name =~ /_/){
2608                    ($name) = ($key->[1]) =~ /(.*?)_/;
2609                }
2610                push (@{$code_attributes{$key->[0]}}, $name);
2611                push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2612            }
2613    
2614            foreach my $id (@$ids){
2615                # add pfam code
2616                my $pfam_codes=" &nbsp; ";
2617                my @pfam_codes = "";
2618                my %description_codes;
2619    
2620                if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2621                    my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2622                    @pfam_codes = ();
2623    
2624                    # get only unique values
2625                    my %saw;
2626                    foreach my $key (@ncodes) {$saw{$key}=1;}
2627                    @ncodes = keys %saw;
2628    
2629                    foreach my $code (@ncodes) {
2630                        my @parts = split("::",$code);
2631                        my $pfam_link = "<a href=http://pfam.sanger.ac.uk/family?acc=" . $parts[1] . ">$parts[1]</a>";
2632    
2633                        # get the locations for the domain
2634                        my @locs;
2635                        foreach my $part (@{$attribute_location{$id}{$code}}){
2636                            my ($loc) = ($part) =~ /\;(.*)/;
2637                            push (@locs,$loc);
2638                        }
2639                        my %locsaw;
2640                        foreach my $key (@locs) {$locsaw{$key}=1;}
2641                        @locs = keys %locsaw;
2642    
2643                        my $locations = join (", ", @locs);
2644    
2645                        if (defined ($description_codes{$parts[1]})){
2646                            push(@pfam_codes, "$parts[1] ($locations)");
2647                        }
2648                        else {
2649                            my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2650                            $description_codes{$parts[1]} = $description->[0]->{term};
2651                            push(@pfam_codes, "$pfam_link ($locations)");
2652                        }
2653                    }
2654    
2655                    if ($returnType eq 'hash') { $column->{$id} = join("<br><br>", @pfam_codes); }
2656                    elsif ($returnType eq 'array') { push (@$column, join("<br><br>", @pfam_codes)); }
2657                }
2658            }
2659        }
2660        elsif ($colName eq 'cellular_location'){
2661            if (! defined $attributes) {
2662                my @attributes_array = $fig->get_attributes($ids);
2663                $attributes = \@attributes_array;
2664            }
2665    
2666            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2667            foreach my $key (@codes){
2668                my ($loc) = ($key->[1]) =~ /::(.*)/;
2669                my ($new_loc, @all);
2670                @all = split (//, $loc);
2671                my $count = 0;
2672                foreach my $i (@all){
2673                    if ( ($i eq uc($i)) && ($count > 0) ){
2674                        $new_loc .= " " . $i;
2675                    }
2676                    else{
2677                        $new_loc .= $i;
2678                    }
2679                    $count++;
2680                }
2681                push (@{$code_attributes{$key->[0]}}, [$new_loc, $key->[2]]);
2682            }
2683    
2684            foreach my $id (@$ids){
2685                my (@values, $entry);
2686                #@values = (" ");
2687                if (defined @{$code_attributes{$id}}){
2688                    my @ncodes = @{$code_attributes{$id}};
2689                    foreach my $code (@ncodes){
2690                        push (@values, $code->[0] . ", " . $code->[1]);
2691                    }
2692                }
2693                else{
2694                    @values = ("Not available");
2695                }
2696    
2697                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2698                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2699            }
2700        }
2701        elsif ( ($colName eq 'mw') || ($colName eq 'transmembrane') || ($colName eq 'similar_to_human') ||
2702                ($colName eq 'signal_peptide') || ($colName eq 'isoelectric') ){
2703            if (! defined $attributes) {
2704                my @attributes_array = $fig->get_attributes($ids);
2705                $attributes = \@attributes_array;
2706            }
2707    
2708            my @codes = grep { $_->[1] =~ /^$attrbName/i } @$attributes;
2709            foreach my $key (@codes){
2710                push (@{$code_attributes{$key->[0]}}, $key->[2]);
2711            }
2712    
2713            foreach my $id (@$ids){
2714                my (@values, $entry);
2715                #@values = (" ");
2716                if (defined @{$code_attributes{$id}}){
2717                    my @ncodes = @{$code_attributes{$id}};
2718                    foreach my $code (@ncodes){
2719                        push (@values, $code);
2720                    }
2721                }
2722                else{
2723                    @values = ("Not available");
2724                }
2725    
2726                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2727                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2728            }
2729        }
2730        elsif ( ($colName eq 'habitat') || ($colName eq 'temperature') || ($colName eq 'temp_range') ||
2731                ($colName eq 'oxygen') || ($colName eq 'pathogenic') || ($colName eq 'pathogenic_in') ||
2732                ($colName eq 'salinity') || ($colName eq 'motility') || ($colName eq 'gram_stain') ||
2733                ($colName eq 'endospores') || ($colName eq 'shape') || ($colName eq 'disease') ||
2734                ($colName eq 'gc_content') ) {
2735            if (! defined $attributes) {
2736                my @attributes_array = $fig->get_attributes(undef,$attrbName);
2737                $attributes = \@attributes_array;
2738            }
2739    
2740            my $genomes_with_phenotype;
2741            foreach my $attribute (@$attributes){
2742                my $genome = $attribute->[0];
2743                $genomes_with_phenotype->{$genome} = $attribute->[2];
2744            }
2745    
2746            foreach my $id (@$ids){
2747                my $genome = $fig->genome_of($id);
2748                my @values = (' ');
2749                if (defined $genomes_with_phenotype->{$genome}){
2750                    push (@values, $genomes_with_phenotype->{$genome});
2751                }
2752                if ($returnType eq 'hash') { $column->{$id} = join ("<BR>", @values); }
2753                elsif ($returnType eq 'array') { push (@$column, join ("<BR>", @values)); }
2754            }
2755        }
2756    
2757        return $column;
2758    }
2759    
2760    
2761    sub get_db_aliases {
2762        my ($ids,$fig,$db,$cgi,$returnType) = @_;
2763    
2764        my $db_array;
2765        my $all_aliases = $fig->feature_aliases_bulk($ids);
2766        foreach my $id (@$ids){
2767            foreach my $alias (@{$$all_aliases{$id}}){
2768                my $id_db = &Observation::get_database($alias);
2769                next if ( ($id_db ne $db) && ($db ne 'all') );
2770                next if ($aliases->{$id}->{$db});
2771                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2772            }
2773            if (!defined( $aliases->{$id}->{$db})){
2774                $aliases->{$id}->{$db} = " ";
2775            }
2776            #push (@$db_array, {'data'=>  $aliases->{$id}->{$db},'highlight'=>"#ffffff"});
2777            push (@$db_array, $aliases->{$id}->{$db});
2778        }
2779    
2780        if ($returnType eq 'hash') { return $aliases; }
2781        elsif ($returnType eq 'array') { return $db_array; }
2782    }
2783    
2784    
2785    
2786  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; $_ }
2787    
2788    sub color {
2789        my ($evalue) = @_;
2790        my $palette = WebColors::get_palette('vitamins');
2791        my $color;
2792        if ($evalue <= 1e-170){        $color = $palette->[0];    }
2793        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = $palette->[1];    }
2794        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = $palette->[2];    }
2795        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = $palette->[3];    }
2796        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = $palette->[4];    }
2797        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = $palette->[5];    }
2798        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = $palette->[6];    }
2799        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = $palette->[7];    }
2800        elsif (($evalue <= 10) && ($evalue > 1)){        $color = $palette->[8];    }
2801        else{        $color = $palette->[9];    }
2802        return ($color);
2803    }
2804    
2805    
2806  ############################  ############################
# Line 1554  Line 2812 
2812    
2813      my ($class,$dataset) = @_;      my ($class,$dataset) = @_;
2814      my $self = $class->SUPER::new($dataset);      my $self = $class->SUPER::new($dataset);
2815        $self->{context} = $dataset->{'context'};
2816      bless($self,$class);      bless($self,$class);
2817      return $self;      return $self;
2818  }  }
2819    
2820  sub display {  sub display {
2821      my ($self,$gd, $fid) = @_;      my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2822    
2823      my $fig = new FIG;      $taxes = $fig->taxonomy_list();
2824    
2825        my $fid = $self->fig_id;
2826        my $compare_or_coupling = $self->context;
2827        my $gd_window_size = $gd->window_size;
2828        my $range = $gd_window_size;
2829      my $all_regions = [];      my $all_regions = [];
2830        my $gene_associations={};
2831    
2832      #get the organism genome      #get the organism genome
2833      my $target_genome = $fig->genome_of($fid);      my $target_genome = $fig->genome_of($fid);
2834        $gene_associations->{$fid}->{"organism"} = $target_genome;
2835        $gene_associations->{$fid}->{"main_gene"} = $fid;
2836        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2837    
2838      # get location of the gene      # get location of the gene
2839      my $data = $fig->feature_location($fid);      my $data = $fig->feature_location($fid);
2840      my ($contig, $beg, $end);      my ($contig, $beg, $end);
2841        my %reverse_flag;
2842    
2843      if ($data =~ /(.*)_(\d+)_(\d+)$/){      if ($data =~ /(.*)_(\d+)_(\d+)$/){
2844          $contig = $1;          $contig = $1;
# Line 1578  Line 2846 
2846          $end = $3;          $end = $3;
2847      }      }
2848    
2849        my $offset;
2850      my ($region_start, $region_end);      my ($region_start, $region_end);
2851      if ($beg < $end)      if ($beg < $end)
2852      {      {
2853          $region_start = $beg - 4000;          $region_start = $beg - ($range);
2854          $region_end = $end+4000;          $region_end = $end+ ($range);
2855            $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2856      }      }
2857      else      else
2858      {      {
2859          $region_end = $end+4000;          $region_start = $end-($range);
2860          $region_start = $beg-4000;          $region_end = $beg+($range);
2861            $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2862            $reverse_flag{$target_genome} = $fid;
2863            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2864      }      }
2865    
2866      # call genes in region      # call genes in region
2867      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);
2868        #foreach my $feat (@$target_gene_features){
2869        #   push (@$all_regions, $feat) if ($feat =~ /peg/);
2870        #}
2871      push(@$all_regions,$target_gene_features);      push(@$all_regions,$target_gene_features);
2872      my (@start_array_region);      my (@start_array_region);
2873      push (@start_array_region, $region_start);      push (@start_array_region, $offset);
2874    
2875      my %all_genes;      my %all_genes;
2876      my %all_genomes;      my %all_genomes;
2877      foreach my $feature (@$target_gene_features){ $all_genes{$feature} = 1;}      foreach my $feature (@$target_gene_features){
2878            #if ($feature =~ /peg/){
2879      my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1);              $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;
2880            #}
2881        }
2882    
2883      my $count_coup = @coup;      my @selected_sims;
     my $coup_count = 0;  
2884    
2885      foreach my $pair (@{$coup[0]->[2]}) {      if ($compare_or_coupling eq "sims"){
2886          last if ($coup_count > 10);          # get the selected boxes
2887          my ($peg1,$peg2) = @$pair;          my @selected_taxonomy = @$selected_taxonomies;
2888    
2889          my $location = $fig->feature_location($peg1);          # get the similarities and store only the ones that match the lineages selected
2890          my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome);          if (@selected_taxonomy > 0){
2891          if($location =~/(.*)_(\d+)_(\d+)$/){              foreach my $sim (@$sims_array){
2892              $pair_contig = $1;                  next if ($sim->class ne "SIM");
2893              $pair_beg = $2;                  next if ($sim->acc !~ /fig\|/);
2894              $pair_end = $3;  
2895              if ($pair_beg < $pair_end)                  #my $genome = $fig->genome_of($sim->[1]);
2896              {                  my $genome = $fig->genome_of($sim->acc);
2897                  $pair_region_start = $pair_beg - 4000;                  #my ($genome1) = ($genome) =~ /(.*)\./;
2898                  $pair_region_stop = $pair_end+4000;                  my $lineage = $taxes->{$genome};
2899                    #my $lineage = $fig->taxonomy_of($fig->genome_of($genome));
2900                    foreach my $taxon(@selected_taxonomy){
2901                        if ($lineage =~ /$taxon/){
2902                            #push (@selected_sims, $sim->[1]);
2903                            push (@selected_sims, $sim->acc);
2904              }              }
             else  
             {  
                 $pair_region_stop = $pair_end+4000;  
                 $pair_region_start = $pair_beg-4000;  
2905              }              }
2906                }
2907            }
2908            else{
2909                my $simcount = 0;
2910                foreach my $sim (@$sims_array){
2911                    next if ($sim->class ne "SIM");
2912                    next if ($sim->acc !~ /fig\|/);
2913    
2914              push (@start_array_region, $pair_region_start);                  push (@selected_sims, $sim->acc);
2915                    $simcount++;
2916              $pair_genome = $fig->genome_of($peg1);                  last if ($simcount > 4);
             $all_genomes{$pair_genome} = 1;  
             my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop);  
             push(@$all_regions,$pair_features);  
             foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = 1;}  
2917          }          }
         $coup_count++;  
2918      }      }
2919    
2920      my $bbh_sets = [];          my %saw;
2921      my %already;          @selected_sims = grep(!$saw{$_}++, @selected_sims);
     foreach my $gene_key (keys(%all_genes)){  
         if($already{$gene_key}){next;}  
         my $gene_set = [$gene_key];  
2922    
2923          my $gene_key_genome = $fig->genome_of($gene_key);          # get the gene context for the sorted matches
2924            foreach my $sim_fid(@selected_sims){
2925                #get the organism genome
2926                my $sim_genome = $fig->genome_of($sim_fid);
2927                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2928                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2929                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2930    
2931          foreach my $genome_key (keys(%all_genomes)){              # get location of the gene
2932              #next if ($gene_key_genome eq $genome_key);              my $data = $fig->feature_location($sim_fid);
2933              my $return = $fig->bbh_list($genome_key,[$gene_key]);              my ($contig, $beg, $end);
2934    
2935              my $feature_list = $return->{$gene_key};              if ($data =~ /(.*)_(\d+)_(\d+)$/){
2936              foreach my $fl (@$feature_list){                  $contig = $1;
2937                  push(@$gene_set,$fl);                  $beg = $2;
2938                    $end = $3;
2939              }              }
2940    
2941                my $offset;
2942                my ($region_start, $region_end);
2943                if ($beg < $end)
2944                {
2945                    $region_start = $beg - ($range/2);
2946                    $region_end = $end+($range/2);
2947                    $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2948          }          }
2949          $already{$gene_key} = 1;              else
2950          push(@$bbh_sets,$gene_set);              {
2951                    $region_start = $end-($range/2);
2952                    $region_end = $beg+($range/2);
2953                    $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2954                    $reverse_flag{$sim_genome} = $sim_fid;
2955                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2956      }      }
2957    
2958      my %bbh_set_rank;              # call genes in region
2959      my $order = 0;              my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2960      foreach my $set (@$bbh_sets){              push(@$all_regions,$sim_gene_features);
2961          my $count = scalar(@$set);              push (@start_array_region, $offset);
2962          $bbh_set_rank{$order} = $count;              foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2963          $order++;              $all_genomes{$sim_genome} = 1;
2964      }      }
2965    
     my %peg_rank;  
     my $counter =  1;  
     foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){  
         my $good_set = @$bbh_sets[$bbh_order];  
         foreach my $peg (@$good_set){  
             if(!$peg_rank{$peg}){  
                 $peg_rank{$peg} = $counter;  
             }  
         }  
         $counter++;  
2966      }      }
2967    
2968      open (FH, ">$FIG_Config::temp/good_sets.txt");      #print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2969      foreach my $pr (keys(%peg_rank)){ print FH "pr:$pr rank:$peg_rank{$pr}\n";}      # cluster the genes
2970      close (FH);      my @all_pegs = keys %all_genes;
2971        my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2972        #print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2973        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2974    
2975      foreach my $region (@$all_regions){      foreach my $region (@$all_regions){
2976          my $sample_peg = @$region[0];          my $sample_peg = @$region[0];
2977          my $region_genome = $fig->genome_of($sample_peg);          my $region_genome = $fig->genome_of($sample_peg);
2978          my $region_gs = $fig->genus_species($region_genome);          my $region_gs = $fig->genus_species($region_genome);
2979            my $abbrev_name = $fig->abbrev($region_gs);
2980            #my ($genome1) = ($region_genome) =~ /(.*?)\./;
2981            my $lineage = $taxes->{$region_genome};
2982            #my $lineage = $fig->taxonomy_of($region_genome);
2983            #$region_gs .= "Lineage:$lineage";
2984          my $line_config = { 'title' => $region_gs,          my $line_config = { 'title' => $region_gs,
2985                              'short_title' => $region_gs,                              'short_title' => $abbrev_name,
2986                              'basepair_offset' => '0'                              'basepair_offset' => '0'
2987                              };                              };
2988    
2989          my $offset = shift @start_array_region;          my $offsetting = shift @start_array_region;
2990    
2991            my $second_line_config = { 'title' => "$lineage",
2992                                       'short_title' => "",
2993                                       'basepair_offset' => '0',
2994                                       'no_middle_line' => '1'
2995                                       };
2996    
2997          my $line_data = [];          my $line_data = [];
2998            my $second_line_data = [];
2999    
3000            # initialize variables to check for overlap in genes
3001            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
3002            my $major_line_flag = 0;
3003            my $prev_second_flag = 0;
3004    
3005          foreach my $fid1 (@$region){          foreach my $fid1 (@$region){
3006                $second_line_flag = 0;
3007              my $element_hash;              my $element_hash;
3008              my $links_list = [];              my $links_list = [];
3009              my $descriptions = [];              my $descriptions = [];
3010    
3011              my $color = $peg_rank{$fid1};              my $color = $color_sets->{$fid1};
3012              if ($color == 1) {  
3013                  print STDERR "PEG: $fid1, RANK: $color";              # get subsystem information
3014                my $function = $fig->function_of($fid1);
3015                my $url_link = "?page=Annotation&feature=".$fid1;
3016    
3017                my $link;
3018                $link = {"link_title" => $fid1,
3019                         "link" => $url_link};
3020                push(@$links_list,$link);
3021    
3022                my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
3023                my @subsystems;
3024                foreach my $array (@subs){
3025                    my $subsystem = $$array[0];
3026                    my $ss = $subsystem;
3027                    $ss =~ s/_/ /ig;
3028                    push (@subsystems, $ss);
3029                    my $link;
3030                    $link = {"link" => "?page=Subsystems&subsystem=$subsystem",
3031                             "link_title" => $ss};
3032                    push(@$links_list,$link);
3033                }
3034    
3035                if ($fid1 eq $fid){
3036                    my $link;
3037                    $link = {"link_title" => "Annotate this sequence",
3038                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
3039                    push (@$links_list,$link);
3040              }              }
3041    
3042                my $description_function;
3043                $description_function = {"title" => "function",
3044                                         "value" => $function};
3045                push(@$descriptions,$description_function);
3046    
3047                my $description_ss;
3048                my $ss_string = join (", ", @subsystems);
3049                $description_ss = {"title" => "subsystems",
3050                                   "value" => $ss_string};
3051                push(@$descriptions,$description_ss);
3052    
3053    
3054              my $fid_location = $fig->feature_location($fid1);              my $fid_location = $fig->feature_location($fid1);
3055              if($fid_location =~/(.*)_(\d+)_(\d+)$/){              if($fid_location =~/(.*)_(\d+)_(\d+)$/){
3056                  my($start,$stop);                  my($start,$stop);
3057                  if ($2 < $3){$start = $2; $stop = $3;}                  $start = $2 - $offsetting;
3058                  else{$stop = $2; $start = $3;}                  $stop = $3 - $offsetting;
3059                  $start = $start - $offset;  
3060                  $stop = $stop - $offset;                  if ( (($prev_start) && ($prev_stop) ) &&
3061                         ( ($start < $prev_start) || ($start < $prev_stop) ||
3062                           ($stop < $prev_start) || ($stop < $prev_stop) )){
3063                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
3064                            $second_line_flag = 1;
3065                            $major_line_flag = 1;
3066                        }
3067                    }
3068                    $prev_start = $start;
3069                    $prev_stop = $stop;
3070                    $prev_fig = $fid1;
3071    
3072                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_gnes{$fid1})){
3073                        $start = $gd_window_size - $start;
3074                        $stop = $gd_window_size - $stop;
3075                    }
3076    
3077                    my $title = $fid1;
3078                    if ($fid1 eq $fid){
3079                        $title = "My query gene: $fid1";
3080                    }
3081    
3082                  $element_hash = {                  $element_hash = {
3083                      "title" => $fid1,                      "title" => $title,
3084                      "start" => $start,                      "start" => $start,
3085                      "end" =>  $stop,                      "end" =>  $stop,
3086                      "type"=> 'arrow',                      "type"=> 'arrow',
3087                      "color"=> $color,                      "color"=> $color,
3088                      "zlayer" => "2"                      "zlayer" => "2",
3089                        "links_list" => $links_list,
3090                        "description" => $descriptions
3091                  };                  };
3092                  push(@$line_data,$element_hash);  
3093                    # if there is an overlap, put into second line
3094                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3095                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3096    
3097                    if ($fid1 eq $fid){
3098                        $element_hash = {
3099                            "title" => 'Query',
3100                            "start" => $start,
3101                            "end" =>  $stop,
3102                            "type"=> 'bigbox',
3103                            "color"=> $color,
3104                            "zlayer" => "1"
3105                            };
3106    
3107                        # if there is an overlap, put into second line
3108                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
3109                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
3110                    }
3111              }              }
3112          }          }
3113          $gd->add_line($line_data, $line_config);          $gd->add_line($line_data, $line_config);
3114            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
3115      }      }
3116      return $gd;      return ($gd, \@selected_sims);
3117    }
3118    
3119    sub cluster_genes {
3120        my($fig,$all_pegs,$peg) = @_;
3121        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
3122    
3123        my @color_sets = ();
3124    
3125        $conn = &get_connections_by_similarity($fig,$all_pegs);
3126    
3127        for ($i=0; ($i < @$all_pegs); $i++) {
3128            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
3129            if (! $seen{$i}) {
3130                $cluster = [$i];
3131                $seen{$i} = 1;
3132                for ($j=0; ($j < @$cluster); $j++) {
3133                    $x = $conn->{$cluster->[$j]};
3134                    foreach $k (@$x) {
3135                        if (! $seen{$k}) {
3136                            push(@$cluster,$k);
3137                            $seen{$k} = 1;
3138                        }
3139                    }
3140                }
3141    
3142                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
3143                    push(@color_sets,$cluster);
3144                }
3145            }
3146        }
3147        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
3148        $red_set = $color_sets[$i];
3149        splice(@color_sets,$i,1);
3150        @color_sets = sort { @$b <=> @$a } @color_sets;
3151        unshift(@color_sets,$red_set);
3152    
3153        my $color_sets = {};
3154        for ($i=0; ($i < @color_sets); $i++) {
3155            foreach $x (@{$color_sets[$i]}) {
3156                $color_sets->{$all_pegs->[$x]} = $i;
3157            }
3158        }
3159        return $color_sets;
3160    }
3161    
3162    sub get_connections_by_similarity {
3163        my($fig,$all_pegs) = @_;
3164        my($i,$j,$tmp,$peg,%pos_of);
3165        my($sim,%conn,$x,$y);
3166    
3167        for ($i=0; ($i < @$all_pegs); $i++) {
3168            $tmp = $fig->maps_to_id($all_pegs->[$i]);
3169            push(@{$pos_of{$tmp}},$i);
3170            if ($tmp ne $all_pegs->[$i]) {
3171                push(@{$pos_of{$all_pegs->[$i]}},$i);
3172            }
3173        }
3174    
3175        foreach $y (keys(%pos_of)) {
3176            $x = $pos_of{$y};
3177            for ($i=0; ($i < @$x); $i++) {
3178                for ($j=$i+1; ($j < @$x); $j++) {
3179                    push(@{$conn{$x->[$i]}},$x->[$j]);
3180                    push(@{$conn{$x->[$j]}},$x->[$i]);
3181                }
3182            }
3183        }
3184    
3185        for ($i=0; ($i < @$all_pegs); $i++) {
3186            foreach $sim ($fig->sims($all_pegs->[$i],500,10,"raw")) {
3187                if (defined($x = $pos_of{$sim->id2})) {
3188                    foreach $y (@$x) {
3189                        push(@{$conn{$i}},$y);
3190                    }
3191                }
3192            }
3193        }
3194        return \%conn;
3195    }
3196    
3197    sub in {
3198        my($x,$xL) = @_;
3199        my($i);
3200    
3201        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
3202        return ($i < @$xL);
3203  }  }
3204    
3205    #############################################
3206    #############################################
3207    package Observation::Commentary;
3208    
3209    use base qw(Observation);
3210    
3211    =head3 display_protein_commentary()
3212    
3213    =cut
3214    
3215    sub display_protein_commentary {
3216        my ($self,$dataset,$mypeg,$fig) = @_;
3217    
3218        my $all_rows = [];
3219        my $content;
3220        #my $fig = new FIG;
3221        my $cgi = new CGI;
3222        my $count = 0;
3223        my $peg_array = [];
3224        my ($evidence_column, $subsystems_column,  %e_identical);
3225    
3226        if (@$dataset != 1){
3227            foreach my $thing (@$dataset){
3228                if ($thing->class eq "SIM"){
3229                    push (@$peg_array, $thing->acc);
3230                }
3231            }
3232            # get the column for the evidence codes
3233            $evidence_column = &Observation::Sims::get_evidence_column($peg_array, undef, $fig, $cgi, 'hash');
3234    
3235            # get the column for the subsystems
3236            $subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig, $cgi, 'array');
3237    
3238            # get essentially identical seqs
3239            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
3240        }
3241        else{
3242            push (@$peg_array, @$dataset);
3243        }
3244    
3245        my $selected_sims = [];
3246        foreach my $id (@$peg_array){
3247            last if ($count > 10);
3248            my $row_data = [];
3249            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
3250            $org = $fig->org_of($id);
3251            $function = $fig->function_of($id);
3252            if ($mypeg ne $id){
3253                $function_cell = "<input type='radio' name='function' id='$id' value='$function' onClick=\"clearText('setAnnotation');\">&nbsp;&nbsp;$function";
3254                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3255                if (defined($e_identical{$id})) { $id_cell .= "*";}
3256            }
3257            else{
3258                $function_cell = "&nbsp;&nbsp;$function";
3259                $id_cell = "<input type='checkbox' name='peg' id='peg$count' value='$id' checked='true'>";
3260                $id_cell .= "<a href='?page=Annotation&feature=$id'>$id</a>"; # &HTML::set_prot_links($cgi,$id);
3261            }
3262    
3263            push(@$row_data,$id_cell);
3264            push(@$row_data,$org);
3265            push(@$row_data, $subsystems_column->{$id}) if ($mypeg ne $id);
3266            push(@$row_data, $evidence_column->{$id}) if ($mypeg ne $id);
3267            push(@$row_data, $fig->translation_length($id));
3268            push(@$row_data,$function_cell);
3269            push(@$all_rows,$row_data);
3270            push (@$selected_sims, $id);
3271            $count++;
3272        }
3273    
3274        if ($count >0){
3275            $content = $all_rows;
3276        }
3277        else{
3278            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
3279        }
3280        return ($content,$selected_sims);
3281    }
3282    
3283    sub display_protein_history {
3284        my ($self, $id,$fig) = @_;
3285        my $all_rows = [];
3286        my $content;
3287    
3288        my $cgi = new CGI;
3289        my $count = 0;
3290        foreach my $feat ($fig->feature_annotations($id)){
3291            my $row = [];
3292            my $col1 = $feat->[2];
3293            my $col2 = $feat->[1];
3294            #my $text = "<pre>" . $feat->[3] . "<\pre>";
3295            my $text = $feat->[3];
3296    
3297            push (@$row, $col1);
3298            push (@$row, $col2);
3299            push (@$row, $text);
3300            push (@$all_rows, $row);
3301            $count++;
3302        }
3303        if ($count > 0){
3304            $content = $all_rows;
3305        }
3306        else {
3307            $content = "There is no history for this PEG";
3308        }
3309    
3310        return($content);
3311    }
3312    

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.60

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3