[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.2, Tue Jun 12 16:51:53 2007 UTC revision 1.41, Tue Oct 9 19:05:29 2007 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);
9    
10  use strict;  use FIG_Config;
11  use warnings;  #use strict;
12    #use warnings;
13    use HTML;
14    
15  1;  1;
16    
# Line 21  Line 27 
27    
28  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).
29    
 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  
   
30  =cut  =cut
31    
32  =head1 BACKGROUND  =head1 BACKGROUND
# Line 64  Line 50 
50    
51  The public methods this package provides are listed below:  The public methods this package provides are listed below:
52    
53    
54    =head3 context()
55    
56    Returns close or diverse for purposes of displaying genomic context
57    
58    =cut
59    
60    sub context {
61      my ($self) = @_;
62    
63      return $self->{context};
64    }
65    
66    =head3 rows()
67    
68    each row in a displayed table
69    
70    =cut
71    
72    sub rows {
73      my ($self) = @_;
74    
75      return $self->{rows};
76    }
77    
78  =head3 acc()  =head3 acc()
79    
80  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 72  Line 83 
83    
84  sub acc {  sub acc {
85    my ($self) = @_;    my ($self) = @_;
   
86    return $self->{acc};    return $self->{acc};
87  }  }
88    
89  =head3 description()  =head3 query()
   
 The description of the hit. Taken from the data or from the our Ontology database for some cases e.g. IPR or PFAM.  
90    
91  B<Please note:>  The query id
 Either remoteid or description is required.  
92    
93  =cut  =cut
94    
95  sub description {  sub query {
96    my ($self) = @_;    my ($self) = @_;
97        return $self->{query};
   return $self->{acc};  
98  }  }
99    
100    
101  =head3 class()  =head3 class()
102    
103  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 100  Line 107 
107    
108  =over 9  =over 9
109    
110  =item sim (seq)  =item IDENTICAL (seq)
111    
112    =item SIM (seq)
113    
114  =item bbh (seq)  =item BBH (seq)
115    
116  =item pch (fc)  =item PCH (fc)
117    
118  =item figfam (seq)  =item FIGFAM (seq)
119    
120  =item ipr (dom)  =item IPR (dom)
121    
122  =item cdd (dom)  =item CDD (dom)
123    
124  =item pfam (dom)  =item PFAM (dom)
125    
126  =item signalp (dom)  =item SIGNALP_CELLO_TMPRED (loc)
127    
128  =item cello (loc)  =item PDB (seq)
129    
130  =item tmhmm (loc)  =item TMHMM (loc)
131    
132  =item hmmtop (loc)  =item HMMTOP (loc)
133    
134  =back  =back
135    
# Line 155  Line 164 
164  sub type {  sub type {
165    my ($self) = @_;    my ($self) = @_;
166    
167    return $self->{acc};    return $self->{type};
168  }  }
169    
170  =head3 start()  =head3 start()
# Line 182  Line 191 
191    return $self->{stop};    return $self->{stop};
192  }  }
193    
194  =head3 evalue()  =head3 start()
195    
196  E-value or P-Value if present.  Start of hit in query sequence.
197    
198  =cut  =cut
199    
200  sub evalue {  sub qstart {
201    my ($self) = @_;    my ($self) = @_;
202    
203    return $self->{evalue};      return $self->{qstart};
204  }  }
205    
206  =head3 score()  =head3 qstop()
   
 Score if present.  
207    
208  B<Please note: >  End of the hit in query sequence.
 Either score or eval are required.  
209    
210  =cut  =cut
211    
212  sub score {  sub qstop {
213    my ($self) = @_;    my ($self) = @_;
214    
215    return $self->{score};      return $self->{qstop};
216  }  }
217    
218    =head3 hstart()
219    
220  =head3 display_method()  Start of hit in hit sequence.
221    
222  If available use the function specified here to display the "raw" observation.  =cut
 In the case of a BLAST alignment of fid1 and fid2 a cgi script  
 will be called to display the results of running the command "bl2seq fid1 fid2".  
223    
224  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.  sub hstart {
225        my ($self) = @_;
226    
227        return $self->{hstart};
228    }
229    
230    =head3 end()
231    
232    End of the hit in hit sequence.
233    
234  =cut  =cut
235    
236  sub display_method {  sub hstop {
237    my ($self) = @_;    my ($self) = @_;
238    
239    # add code here      return $self->{hstop};
   
   return $self->{display_method};  
240  }  }
241    
242  =head3 rank()  =head3 qlength()
   
 Returns an integer from 1 - 10 indicating the importance of this observations.  
243    
244  Currently always returns 1.  length of the query sequence in similarities
245    
246  =cut  =cut
247    
248  sub rank {  sub qlength {
249    my ($self) = @_;    my ($self) = @_;
250    
251  #  return $self->{rank};      return $self->{qlength};
   
   return 1;  
252  }  }
253    
254  =head3 supports_annotation()  =head3 hlength()
   
 Does a this observation support the annotation of its feature?  
255    
256  Returns  length of the hit sequence in similarities
257    
258  =over 3  =cut
259    
260  =item 10, if feature annotation is identical to $self->description  sub hlength {
261        my ($self) = @_;
262    
263  =item 1, Feature annotation is similar to $self->annotation; this is computed using FIG::SameFunc()      return $self->{hlength};
264    }
265    
266  =item undef  =head3 evalue()
267    
268  =back  E-value or P-Value if present.
269    
270  =cut  =cut
271    
272  sub supports_annotation {  sub evalue {
273    my ($self) = @_;    my ($self) = @_;
274    
275    # no code here so far    return $self->{evalue};
   
   return $self->{supports_annotation};  
276  }  }
277    
278  =head3 url()  =head3 score()
279    
280  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.  Score if present.
281    
282  =cut  =cut
283    
284  sub url {  sub score {
285    my ($self) = @_;    my ($self) = @_;
286      return $self->{score};
287    }
288    
289    my $url = get_url($self->type, $self->acc);  =head3 display()
290    
291    will be different for each type
292    
293    =cut
294    
295    sub display {
296    
297      die "Abstract Method Called\n";
298    
   return $url;  
299  }  }
300    
301  =head3 get_objects()  =head3 display_table()
302    
303  This is the B<REAL WORKHORSE> method of this Package.  will be different for each type
304    
305    =cut
306    
307    sub display_table {
308    
309  It will probably have to:    die "Abstract Table Method Called\n";
310    
 - 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 $datasets =  
      [  
        [ { 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;  
311   }   }
312    
313  It will invoke the required calls to the SEED API to retrieve the information required.  =head3 get_objects()
314    
315    This is the B<REAL WORKHORSE> method of this Package.
316    
317  =cut  =cut
318    
319  sub get_objects {  sub get_objects {
320      my ($self,$fid) = @_;      my ($self,$fid,$fig,$scope) = @_;
321    
322      my $objects = [];      my $objects = [];
323    my @matched_datasets=();    my @matched_datasets=();
324        #my $fig = new FIG;
325    
326    # call function that fetches attribut based observations      # call function that fetches attribute based observations
327    # returns an array of arrays of hashes    # returns an array of arrays of hashes
   #  
   get_attribute_based_observations($fid,\@matched_datasets);  
328    
329    # read sims + bbh (enrich BBHs with sims coordindates etc)      if($scope){
330    # read pchs          get_cluster_observations($fid,\@matched_datasets,$scope);
331    # read figfam match data from 48hr directory (BobO knows how do do this!)      }
332    # what sources of evidence did I miss?      else{
333            my %domain_classes;
334            my @attributes = $fig->get_attributes($fid);
335            $domain_classes{'CDD'} = 1;
336            $domain_classes{'PFAM'} = 1;
337            get_identical_proteins($fid,\@matched_datasets,$fig);
338            get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes,$fig);
339            get_sims_observations($fid,\@matched_datasets,$fig);
340            get_functional_coupling($fid,\@matched_datasets,$fig);
341            get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes,$fig);
342            get_pdb_observations($fid,\@matched_datasets,\@attributes,$fig);
343        }
344    
345    foreach my $dataset (@matched_datasets) {    foreach my $dataset (@matched_datasets) {
346      my $object = $self->new();          my $object;
347      foreach my $attribute (@$dataset) {          if($dataset->{'type'} eq "dom"){
348        $object->{$attribute->{'name'}} = $attribute->{'value'};              $object = Observation::Domain->new($dataset);
349      }      }
350  #    $object->{$attribute->{'feature_id'}} = $attribute->{$fid};          elsif($dataset->{'class'} eq "PCH"){
351      push (@$objects, $object);              $object = Observation::FC->new($dataset);
352            }
353            elsif ($dataset->{'class'} eq "IDENTICAL"){
354                $object = Observation::Identical->new($dataset);
355            }
356            elsif ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){
357                $object = Observation::Location->new($dataset);
358            }
359            elsif ($dataset->{'class'} eq "SIM"){
360                $object = Observation::Sims->new($dataset);
361            }
362            elsif ($dataset->{'class'} eq "CLUSTER"){
363                $object = Observation::Cluster->new($dataset);
364            }
365            elsif ($dataset->{'class'} eq "PDB"){
366                $object = Observation::PDB->new($dataset);
367      }      }
368    
369            push (@$objects, $object);
370        }
371    
372    return $objects;    return $objects;
373    
374    }
375    
376    =head3 display_housekeeping
377    This method returns the housekeeping data for a given peg in a table format
378    
379    =cut
380    sub display_housekeeping {
381        my ($self,$fid,$fig) = @_;
382        my $content = [];
383        my $row = [];
384    
385        my $org_name = $fig->org_of($fid);
386        my $function = $fig->function_of($fid);
387        #my $taxonomy = $fig->taxonomy_of($org_id);
388        my $length = $fig->translation_length($fid);
389    
390        push (@$row, $org_name);
391        push (@$row, $fid);
392        push (@$row, $length);
393        push (@$row, $function);
394    
395        # initialize the table for commentary and annotations
396        #$content .= qq(<b>My Sequence Data</b><br><table border="0">);
397        #$content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n);
398        #$content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name</td></tr>\n);
399        #$content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n);
400        #$content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n);
401        #$content .= qq(<tr width=15%><td>Sequence Length</td><td>$length aa</td></tr>\n);
402        #$content .= qq(</table><p>\n);
403    
404        push(@$content, $row);
405    
406        return ($content);
407    }
408    
409    =head3 get_sims_summary
410    This method uses as input the similarities of a peg and creates a tree view of their taxonomy
411    
412    =cut
413    
414    sub get_sims_summary {
415        my ($observation, $fid, $taxes,$fig) = @_;
416        #my $fig = new FIG;
417        my %families;
418        my @sims= $fig->nsims($fid,20000,10,"fig");
419    
420        foreach my $sim (@sims){
421            next if ($sim->[1] !~ /fig\|/);
422            my $genome = $fig->genome_of($sim->[1]);
423            my ($genome1) = ($genome) =~ /(.*)\./;
424            my $taxonomy = $taxes->{$genome1};
425            #my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); # use this if the taxonomies have been updated
426            my $parent_tax = "Root";
427            my @currLineage = ($parent_tax);
428            foreach my $tax (split(/\; /, $taxonomy)){
429                push (@{$families{children}{$parent_tax}}, $tax);
430                push (@currLineage, $tax);
431                $families{parent}{$tax} = $parent_tax;
432                $families{lineage}{$tax} = join(";", @currLineage);
433                if (defined ($families{evalue}{$tax})){
434                    if ($sim->[10] < $families{evalue}{$tax}){
435                        $families{evalue}{$tax} = $sim->[10];
436                        $families{color}{$tax} = &get_taxcolor($sim->[10]);
437                    }
438                }
439                else{
440                    $families{evalue}{$tax} = $sim->[10];
441                    $families{color}{$tax} = &get_taxcolor($sim->[10]);
442                }
443    
444                $parent_tax = $tax;
445            }
446        }
447    
448        foreach my $key (keys %{$families{children}}){
449            $families{count}{$key} = @{$families{children}{$key}};
450    
451            my %saw;
452            my @out = grep(!$saw{$_}++, @{$families{children}{$key}});
453            $families{children}{$key} = \@out;
454        }
455        return (\%families);
456  }  }
457    
458  =head1 Internal Methods  =head1 Internal Methods
# Line 355  Line 463 
463    
464  =cut  =cut
465    
466    sub get_taxcolor{
467        my ($evalue) = @_;
468        my $color;
469        if ($evalue <= 1e-170){        $color = "#FF2000";    }
470        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = "#FF3300";    }
471        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = "#FF6600";    }
472        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = "#FF9900";    }
473        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = "#FFCC00";    }
474        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = "#FFFF00";    }
475        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = "#CCFF00";    }
476        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = "#66FF00";    }
477        elsif (($evalue <= 10) && ($evalue > 1)){        $color = "#00FF00";    }
478        else{        $color = "#6666FF";    }
479        return ($color);
480    }
481    
 =head3 get_url (internal)  
482    
483  get_url() return a valid URL or undef for any observation.  sub get_attribute_based_domain_observations{
484    
485  URLs are constructed by looking at the Accession acc()  and  name()      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)
486        my ($fid,$domain_classes,$datasets_ref,$attributes_ref,$fig) = (@_);
487    
488  Info from both attributes is combined with a table of base URLs stored in this function.      #my $fig = new FIG;
489    
490  =cut      foreach my $attr_ref (@$attributes_ref) {
491            my $key = @$attr_ref[1];
492            my @parts = split("::",$key);
493            my $class = $parts[0];
494    
495            if($domain_classes->{$parts[0]}){
496                my $val = @$attr_ref[2];
497                if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
498                    my $raw_evalue = $1;
499                    my $from = $2;
500                    my $to = $3;
501                    my $evalue;
502                    if($raw_evalue =~/(\d+)\.(\d+)/){
503                        my $part2 = 1000 - $1;
504                        my $part1 = $2/100;
505                        $evalue = $part1."e-".$part2;
506                    }
507                    else{
508                        $evalue = "0.0";
509                    }
510    
511                    my $dataset = {'class' => $class,
512                                   'acc' => $key,
513                                   'type' => "dom" ,
514                                   'evalue' => $evalue,
515                                   'start' => $from,
516                                   'stop' => $to,
517                                   'fig_id' => $fid,
518                                   'score' => $raw_evalue
519                                   };
520    
521                    push (@{$datasets_ref} ,$dataset);
522                }
523            }
524        }
525    }
526    
527  sub get_url {  sub get_attribute_based_location_observations{
528    
529   my ($self) = @_;      my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
530   my $url='';      #my $fig = new FIG;
531    
532  # a hash with a URL for each observation; identified by name()      my $location_attributes = ['SignalP','CELLO','TMPRED','Phobius'];
 #my $URL             => { 'PFAM' => "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?" ,\  
 #                       '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="  
 #};  
533    
534  # if (defined $URL{$self->name}) {      my $dataset = {'type' => "loc",
535  #     $url = $URL{$self->name}.$self->acc;                     'class' => 'SIGNALP_CELLO_TMPRED',
536  #     return $url;                     'fig_id' => $fid
537  # }                     };
538  # else  
539       return undef;      foreach my $attr_ref (@$attributes_ref){
540            my $key = @$attr_ref[1];
541            next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)  && ($key !~/Phobius/) );
542            my @parts = split("::",$key);
543            my $sub_class = $parts[0];
544            my $sub_key = $parts[1];
545            my $value = @$attr_ref[2];
546            if($sub_class eq "SignalP"){
547                if($sub_key eq "cleavage_site"){
548                    my @value_parts = split(";",$value);
549                    $dataset->{'cleavage_prob'} = $value_parts[0];
550                    $dataset->{'cleavage_loc'} = $value_parts[1];
551                }
552                elsif($sub_key eq "signal_peptide"){
553                    $dataset->{'signal_peptide_score'} = $value;
554                }
555            }
556    
557            elsif($sub_class eq "CELLO"){
558                $dataset->{'cello_location'} = $sub_key;
559                $dataset->{'cello_score'} = $value;
560            }
561    
562            elsif($sub_class eq "Phobius"){
563                if($sub_key eq "transmembrane"){
564                    $dataset->{'phobius_tm_locations'} = $value;
565                }
566                elsif($sub_key eq "signal"){
567                    $dataset->{'phobius_signal_location'} = $value;
568                }
569            }
570    
571            elsif($sub_class eq "TMPRED"){
572                my @value_parts = split(/\;/,$value);
573                $dataset->{'tmpred_score'} = $value_parts[0];
574                $dataset->{'tmpred_locations'} = $value_parts[1];
575  }  }
576        }
577    
578        push (@{$datasets_ref} ,$dataset);
579    
580  =head3 get_display_method (internal)  }
581    
582  get_display_method() return a valid URL or undef for any observation.  =head3 get_pdb_observations() (internal)
583    
584  URLs are constructed by looking at the Accession acc()  and  name()  This methods sets the type and class for pdb observations
 and Info from both attributes is combined with a table of base URLs stored in this function.  
585    
586  =cut  =cut
587    
588  sub get_display_method {  sub get_pdb_observations{
589        my ($fid,$datasets_ref, $attributes_ref,$fig) = (@_);
590    
591   my ($self) = @_;      #my $fig = new FIG;
592    
593  # a hash with a URL for each observation; identified by name()      foreach my $attr_ref (@$attributes_ref){
594  #my $URL             => { 'sim'=> "http://www.theseed.org/featalign.cgi?id1=",\          my $key = @$attr_ref[1];
595  #                        'bbh'=> "http://www.theseed.org/featalign.cgi?id1="          next if ( ($key !~ /PDB/));
596  # };          my($key1,$key2) =split("::",$key);
597            my $value = @$attr_ref[2];
598            my ($evalue,$location) = split(";",$value);
599    
600  #if (defined $URL{$self->name}) {          if($evalue =~/(\d+)\.(\d+)/){
601  #     $url = $URL{$self->name}.$self->feature_id."&id2=".$self->acc;              my $part2 = 1000 - $1;
602  #     return $url;              my $part1 = $2/100;
603  # }              $evalue = $part1."e-".$part2;
604  # else          }
605       return undef;  
606            my($start,$stop) =split("-",$location);
607    
608            my $url = @$attr_ref[3];
609            my $dataset = {'class' => 'PDB',
610                           'type' => 'seq' ,
611                           'acc' => $key2,
612                           'evalue' => $evalue,
613                           'start' => $start,
614                           'stop' => $stop,
615                           'fig_id' => $fid
616                           };
617    
618            push (@{$datasets_ref} ,$dataset);
619        }
620  }  }
621    
622  =head3 get_attribute_based_evidence (internal)  =head3 get_cluster_observations() (internal)
623    
624  This method retrieves evidence from the attribute server  This methods sets the type and class for cluster observations
625    
626  =cut  =cut
627    
628  sub get_attribute_based_observations{  sub get_cluster_observations{
629        my ($fid,$datasets_ref,$scope) = (@_);
630    
631      # we read a FIG ID and a reference to an array (of arrays of hashes, see above)      my $dataset = {'class' => 'CLUSTER',
632      my ($fid,$datasets_ref) = (@_);                     'type' => 'fc',
633                       'context' => $scope,
634                       'fig_id' => $fid
635                       };
636        push (@{$datasets_ref} ,$dataset);
637    }
638    
639    
640    =head3 get_sims_observations() (internal)
641    
642    This methods retrieves sims fills the internal data structures.
643    
644      my $_myfig = new FIG;  =cut
645    
646    sub get_sims_observations{
647    
648        my ($fid,$datasets_ref,$fig) = (@_);
649        #my $fig = new FIG;
650        my @sims= $fig->nsims($fid,500,10,"fig");
651        my ($dataset);
652    
653        foreach my $sim (@sims){
654            my $hit = $sim->[1];
655            my $percent = $sim->[2];
656            my $evalue = $sim->[10];
657            my $qfrom = $sim->[6];
658            my $qto = $sim->[7];
659            my $hfrom = $sim->[8];
660            my $hto = $sim->[9];
661            my $qlength = $sim->[12];
662            my $hlength = $sim->[13];
663            my $db = get_database($hit);
664            my $func = $fig->function_of($hit);
665            my $organism = $fig->org_of($hit);
666    
667            $dataset = {'class' => 'SIM',
668                        'query' => $sim->[0],
669                        'acc' => $hit,
670                        'identity' => $percent,
671                        'type' => 'seq',
672                        'evalue' => $evalue,
673                        'qstart' => $qfrom,
674                        'qstop' => $qto,
675                        'hstart' => $hfrom,
676                        'hstop' => $hto,
677                        'database' => $db,
678                        'organism' => $organism,
679                        'function' => $func,
680                        'qlength' => $qlength,
681                        'hlength' => $hlength,
682                        'fig_id' => $fid
683                        };
684    
685      foreach my $attr_ref ($_myfig->get_attributes($fid)) {          push (@{$datasets_ref} ,$dataset);
686        }
687    }
688    
689          # convert the ref into a string for easier handling  =head3 get_database (internal)
690          my ($string) = "@$attr_ref";  This method gets the database association from the sequence id
691    
692  #       print "S:$string\n";  =cut
         my ($key,$val) = ( $string =~ /\S+\s(\S+)\s(\S+)/);  
693    
694          # THIS SHOULD BE DONE ANOTHER WAY FM->TD  sub get_database{
695          # we need to do the right thing for each type, ie no evalue for CELLO and no coordinates, but a score, etc      my ($id) = (@_);
         # as fas as possible this should be configured so that the type of observation and the regexp are  
         # stored somewhere for easy expansion  
         #  
696    
697          if (($key =~ /PFAM::/) || ( $key =~ /IPR::/) || ( $key =~ /CDD::/) ) {      my ($db);
698        if ($id =~ /^fig\|/)              { $db = "FIG" }
699        elsif ($id =~ /^gi\|/)            { $db = "NCBI" }
700        elsif ($id =~ /^^[NXYZA]P_/)      { $db = "RefSeq" }
701        elsif ($id =~ /^sp\|/)            { $db = "SwissProt" }
702        elsif ($id =~ /^uni\|/)           { $db = "UniProt" }
703        elsif ($id =~ /^tigr\|/)          { $db = "TIGR" }
704        elsif ($id =~ /^pir\|/)           { $db = "PIR" }
705        elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/))    { $db = "KEGG" }
706        elsif ($id =~ /^tr\|/)                          { $db = "TrEMBL" }
707        elsif ($id =~ /^eric\|/)          { $db = "ASAP" }
708        elsif ($id =~ /^img\|/)           { $db = "JGI" }
709    
710              # some keys are composite CDD::1233244 or PFAM:PF1233      return ($db);
711    
             if ( $key =~ /::/ ) {  
                 my ($firstkey,$restkey) = ( $key =~ /([a-zA-Z0-9]+)::(.*)/);  
                 $val=$restkey.";".$val;  
                 $key=$firstkey;  
712              }              }
713    
             my ($acc,$raw_evalue, $from,$to) = ($val =~ /(\S+);(\S+);(\d+)-(\d+)/ );  
714    
715              my $evalue= 255;  =head3 get_identical_proteins() (internal)
             if (defined $raw_evalue) { # some of the tool do not give us an evalue  
716    
717                  my ($k,$expo) = ( $raw_evalue =~ /(\d+).(\d+)/);  This methods retrieves sims fills the internal data structures.
                 my ($new_k, $new_exp);  
718    
719                  #  =cut
720                  #  THIS DOES NOT WORK PROPERLY  
721                  #  sub get_identical_proteins{
                 if($raw_evalue =~/(\d+).(\d+)/){  
722    
723  #                   $new_exp = (1000+$expo);      my ($fid,$datasets_ref,$fig) = (@_);
724          #           $new_k = $k / 100;      #my $fig = new FIG;
725        my $funcs_ref;
726    
727        my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
728        foreach my $id (@maps_to) {
729            my ($tmp, $who);
730            if (($id ne $fid) && ($tmp = $fig->function_of($id))) {
731                $who = &get_database($id);
732                push(@$funcs_ref, [$id,$who,$tmp]);
733                  }                  }
                 $evalue = "0.01"#new_k."e-".$new_exp;  
734              }              }
735    
736              # unroll it all into an array of hashes      my $dataset = {'class' => 'IDENTICAL',
737              # this needs to be done differently for different types of observations                     'type' => 'seq',
738              my $dataset = [ { name => 'class', value => $key },                     'fig_id' => $fid,
739                              { name => 'acc' , value => $acc},                     'rows' => $funcs_ref
740                              { 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}  
                             ];  
741    
742              push (@{$datasets_ref} ,$dataset);              push (@{$datasets_ref} ,$dataset);
743          }  
744      }  
745  }  }
746    
747  =head3 get_sims_and_bbhs() (internal)  =head3 get_functional_coupling() (internal)
748    
749  This methods retrieves sims and also BBHs and fills the internal data structures.  This methods retrieves the functional coupling of a protein given a peg ID
750    
751  =cut  =cut
752    
753  #     sub get_sims_and_bbhs{  sub get_functional_coupling{
754    
755  #       # blast m8 output format      my ($fid,$datasets_ref,$fig) = (@_);
756  #       # id1, id2, %ident, align len, mismatches, gaps, q.start, q.stop, s. start, s.stop, eval, bit      #my $fig = new FIG;
757        my @funcs = ();
 #       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";  
 #       }  
758    
759  #       # BBHs      # initialize some variables
760  #       my $BBHs=();      my($sc,$neigh);
761    
762  #       @bbhs_src = $fig->bbhs($fid,1.0e-10);      # set default parameters for coupling and evidence
763  #       print "found $#bbhs_src BBHs\n";      my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4);
 #       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";  
 #       }  
764    
765  #     }      # get the fc data
766        my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1);
767    
768        # retrieve data
769        my @rows = map { ($sc,$neigh) = @$_;
770                         [$sc,$neigh,scalar $fig->function_of($neigh)]
771                      } @fc_data;
772    
773        my ($dataset);
774        my $dataset = {'class' => 'PCH',
775                       'type' => 'fc',
776                       'fig_id' => $fid,
777                       'rows' => \@rows
778                       };
779    
780        push (@{$datasets_ref} ,$dataset);
781    
782    }
783    
784  =head3 new (internal)  =head3 new (internal)
785    
# Line 539  Line 788 
788  =cut  =cut
789    
790  sub new {  sub new {
791    my ($self) = @_;    my ($class,$dataset) = @_;
792    
793    $self = { acc => '',    my $self = { class => $dataset->{'class'},
794              description => '',                 type => $dataset->{'type'},
795              class => '',                 fig_id => $dataset->{'fig_id'},
796              type => '',                 score => $dataset->{'score'},
             start => '',  
             stop => '',  
             evalue => '',  
             score => '',  
             display_method => '',  
             feature_id => '',  
             rank => '',  
             supports_annotation => ''  
797            };            };
798    
799    bless($self, 'Observation');    bless($self,$class);
800    
801    return $self;    return $self;
802  }  }
803    
804    =head3 identity (internal)
805    
806    Returns the % identity of the similar sequence
807    
808    =cut
809    
810    sub identity {
811        my ($self) = @_;
812    
813        return $self->{identity};
814    }
815    
816    =head3 fig_id (internal)
817    
818    =cut
819    
820    sub fig_id {
821      my ($self) = @_;
822      return $self->{fig_id};
823    }
824    
825  =head3 feature_id (internal)  =head3 feature_id (internal)
826    
 Returns the ID  of the feature these Observations belong to.  
827    
828  =cut  =cut
829    
# Line 571  Line 832 
832    
833    return $self->{feature_id};    return $self->{feature_id};
834  }  }
835    
836    =head3 id (internal)
837    
838    Returns the ID  of the identical sequence
839    
840    =cut
841    
842    sub id {
843        my ($self) = @_;
844    
845        return $self->{id};
846    }
847    
848    =head3 organism (internal)
849    
850    Returns the organism  of the identical sequence
851    
852    =cut
853    
854    sub organism {
855        my ($self) = @_;
856    
857        return $self->{organism};
858    }
859    
860    =head3 function (internal)
861    
862    Returns the function of the identical sequence
863    
864    =cut
865    
866    sub function {
867        my ($self) = @_;
868    
869        return $self->{function};
870    }
871    
872    =head3 database (internal)
873    
874    Returns the database of the identical sequence
875    
876    =cut
877    
878    sub database {
879        my ($self) = @_;
880    
881        return $self->{database};
882    }
883    
884    sub score {
885      my ($self) = @_;
886    
887      return $self->{score};
888    }
889    
890    ############################################################
891    ############################################################
892    package Observation::PDB;
893    
894    use base qw(Observation);
895    
896    sub new {
897    
898        my ($class,$dataset) = @_;
899        my $self = $class->SUPER::new($dataset);
900        $self->{acc} = $dataset->{'acc'};
901        $self->{evalue} = $dataset->{'evalue'};
902        $self->{start} = $dataset->{'start'};
903        $self->{stop} = $dataset->{'stop'};
904        bless($self,$class);
905        return $self;
906    }
907    
908    =head3 display()
909    
910    displays data stored in best_PDB attribute and in Ontology server for given PDB id
911    
912    =cut
913    
914    sub display{
915        my ($self,$gd,$fig) = @_;
916    
917        my $fid = $self->fig_id;
918        my $dbmaster = DBMaster->new(-database =>'Ontology');
919    
920        my $acc = $self->acc;
921    
922        my ($pdb_description,$pdb_source,$pdb_ligand);
923        my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } );
924        if(!scalar(@$pdb_objs)){
925            $pdb_description = "not available";
926            $pdb_source = "not available";
927            $pdb_ligand = "not available";
928        }
929        else{
930            my $pdb_obj = $pdb_objs->[0];
931            $pdb_description = $pdb_obj->description;
932            $pdb_source = $pdb_obj->source;
933            $pdb_ligand = $pdb_obj->ligand;
934        }
935    
936        my $lines = [];
937        my $line_data = [];
938        my $line_config = { 'title' => "PDB hit for $fid",
939                            'short_title' => "best PDB",
940                            'basepair_offset' => '1' };
941    
942        #my $fig = new FIG;
943        my $seq = $fig->get_translation($fid);
944        my $fid_stop = length($seq);
945    
946        my $fid_element_hash = {
947            "title" => $fid,
948            "start" => '1',
949            "end" =>  $fid_stop,
950            "color"=> '1',
951            "zlayer" => '1'
952            };
953    
954        push(@$line_data,$fid_element_hash);
955    
956        my $links_list = [];
957        my $descriptions = [];
958    
959        my $name;
960        $name = {"title" => 'id',
961                 "value" => $acc};
962        push(@$descriptions,$name);
963    
964        my $description;
965        $description = {"title" => 'pdb description',
966                        "value" => $pdb_description};
967        push(@$descriptions,$description);
968    
969        my $score;
970        $score = {"title" => "score",
971                  "value" => $self->evalue};
972        push(@$descriptions,$score);
973    
974        my $start_stop;
975        my $start_stop_value = $self->start."_".$self->stop;
976        $start_stop = {"title" => "start-stop",
977                       "value" => $start_stop_value};
978        push(@$descriptions,$start_stop);
979    
980        my $source;
981        $source = {"title" => "source",
982                  "value" => $pdb_source};
983        push(@$descriptions,$source);
984    
985        my $ligand;
986        $ligand = {"title" => "pdb ligand",
987                   "value" => $pdb_ligand};
988        push(@$descriptions,$ligand);
989    
990        my $link;
991        my $link_url ="http://www.rcsb.org/pdb/explore/explore.do?structureId=".$acc;
992    
993        $link = {"link_title" => $acc,
994                 "link" => $link_url};
995        push(@$links_list,$link);
996    
997        my $pdb_element_hash = {
998            "title" => "PDB homology",
999            "start" => $self->start,
1000            "end" =>  $self->stop,
1001            "color"=> '6',
1002            "zlayer" => '3',
1003            "links_list" => $links_list,
1004            "description" => $descriptions};
1005    
1006        push(@$line_data,$pdb_element_hash);
1007        $gd->add_line($line_data, $line_config);
1008    
1009        return $gd;
1010    }
1011    
1012    1;
1013    
1014    ############################################################
1015    ############################################################
1016    package Observation::Identical;
1017    
1018    use base qw(Observation);
1019    
1020    sub new {
1021    
1022        my ($class,$dataset) = @_;
1023        my $self = $class->SUPER::new($dataset);
1024        $self->{rows} = $dataset->{'rows'};
1025    
1026        bless($self,$class);
1027        return $self;
1028    }
1029    
1030    =head3 display_table()
1031    
1032    If available use the function specified here to display the "raw" observation.
1033    This code will display a table for the identical protein
1034    
1035    
1036    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
1037    dence.
1038    
1039    =cut
1040    
1041    
1042    sub display_table{
1043        my ($self,$fig) = @_;
1044    
1045        #my $fig = new FIG;
1046        my $fid = $self->fig_id;
1047        my $rows = $self->rows;
1048        my $cgi = new CGI;
1049        my $all_domains = [];
1050        my $count_identical = 0;
1051        my $content;
1052        foreach my $row (@$rows) {
1053            my $id = $row->[0];
1054            my $who = $row->[1];
1055            my $assignment = $row->[2];
1056            my $organism = $fig->org_of($id);
1057            my $single_domain = [];
1058            push(@$single_domain,$who);
1059            push(@$single_domain,&HTML::set_prot_links($cgi,$id));
1060            push(@$single_domain,$organism);
1061            push(@$single_domain,$assignment);
1062            push(@$all_domains,$single_domain);
1063            $count_identical++;
1064        }
1065    
1066        if ($count_identical >0){
1067            $content = $all_domains;
1068        }
1069        else{
1070            $content = "<p>This PEG does not have any essentially identical proteins</p>";
1071        }
1072        return ($content);
1073    }
1074    
1075    1;
1076    
1077    #########################################
1078    #########################################
1079    package Observation::FC;
1080    1;
1081    
1082    use base qw(Observation);
1083    
1084    sub new {
1085    
1086        my ($class,$dataset) = @_;
1087        my $self = $class->SUPER::new($dataset);
1088        $self->{rows} = $dataset->{'rows'};
1089    
1090        bless($self,$class);
1091        return $self;
1092    }
1093    
1094    =head3 display_table()
1095    
1096    If available use the function specified here to display the "raw" observation.
1097    This code will display a table for the identical protein
1098    
1099    
1100    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
1101    dence.
1102    
1103    =cut
1104    
1105    sub display_table {
1106    
1107        my ($self,$dataset,$fig) = @_;
1108        my $fid = $self->fig_id;
1109        my $rows = $self->rows;
1110        my $cgi = new CGI;
1111        my $functional_data = [];
1112        my $count = 0;
1113        my $content;
1114    
1115        foreach my $row (@$rows) {
1116            my $single_domain = [];
1117            $count++;
1118    
1119            # construct the score link
1120            my $score = $row->[0];
1121            my $toid = $row->[1];
1122            my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT=";
1123            my $sc_link = "<a href=$link>$score</a>";
1124    
1125            push(@$single_domain,$sc_link);
1126            push(@$single_domain,$row->[1]);
1127            push(@$single_domain,$row->[2]);
1128            push(@$functional_data,$single_domain);
1129        }
1130    
1131        if ($count >0){
1132            $content = $functional_data;
1133        }
1134        else
1135        {
1136            $content = "<p>This PEG does not have any functional coupling</p>";
1137        }
1138        return ($content);
1139    }
1140    
1141    
1142    #########################################
1143    #########################################
1144    package Observation::Domain;
1145    
1146    use base qw(Observation);
1147    
1148    sub new {
1149    
1150        my ($class,$dataset) = @_;
1151        my $self = $class->SUPER::new($dataset);
1152        $self->{evalue} = $dataset->{'evalue'};
1153        $self->{acc} = $dataset->{'acc'};
1154        $self->{start} = $dataset->{'start'};
1155        $self->{stop} = $dataset->{'stop'};
1156    
1157        bless($self,$class);
1158        return $self;
1159    }
1160    
1161    sub display {
1162        my ($thing,$gd) = @_;
1163        my $lines = [];
1164    #    my $line_config = { 'title' => $thing->acc,
1165    #                       'short_title' => $thing->type,
1166    #                       'basepair_offset' => '1' };
1167        my $color = "4";
1168    
1169        my $line_data = [];
1170        my $links_list = [];
1171        my $descriptions = [];
1172    
1173        my $db_and_id = $thing->acc;
1174        my ($db,$id) = split("::",$db_and_id);
1175    
1176        my $dbmaster = DBMaster->new(-database =>'Ontology');
1177    
1178        my ($name_title,$name_value,$description_title,$description_value);
1179        if($db eq "CDD"){
1180            my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1181            if(!scalar(@$cdd_objs)){
1182                $name_title = "name";
1183                $name_value = "not available";
1184                $description_title = "description";
1185                $description_value = "not available";
1186            }
1187            else{
1188                my $cdd_obj = $cdd_objs->[0];
1189                $name_title = "name";
1190                $name_value = $cdd_obj->term;
1191                $description_title = "description";
1192                $description_value = $cdd_obj->description;
1193            }
1194        }
1195        elsif($db =~ /PFAM/){
1196            my $pfam_objs = $dbmaster->pfam->get_objects( { 'id' => $id } );
1197            if(!scalar(@$pfam_objs)){
1198                $name_title = "name";
1199                $name_value = "not available";
1200                $description_title = "description";
1201                $description_value = "not available";
1202            }
1203            else{
1204                my $pfam_obj = $pfam_objs->[0];
1205                $name_title = "name";
1206                $name_value = $pfam_obj->term;
1207                #$description_title = "description";
1208                #$description_value = $pfam_obj->description;
1209            }
1210        }
1211    
1212        my $short_title = $thing->acc;
1213        $short_title =~ s/::/ - /ig;
1214        my $line_config = { 'title' => $name_value,
1215                            'short_title' => $short_title,
1216                            'basepair_offset' => '1' };
1217    
1218        my $name;
1219        $name = {"title" => $db,
1220                 "value" => $id};
1221        push(@$descriptions,$name);
1222    
1223    #    my $description;
1224    #    $description = {"title" => $description_title,
1225    #                   "value" => $description_value};
1226    #    push(@$descriptions,$description);
1227    
1228        my $score;
1229        $score = {"title" => "score",
1230                  "value" => $thing->evalue};
1231        push(@$descriptions,$score);
1232    
1233        my $location;
1234        $location = {"title" => "location",
1235                     "value" => $thing->start . " - " . $thing->stop};
1236        push(@$descriptions,$location);
1237    
1238        my $link_id;
1239        if ($thing->acc =~/::(.*)/){
1240            $link_id = $1;
1241        }
1242    
1243        my $link;
1244        my $link_url;
1245        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"}
1246        elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1247        else{$link_url = "NO_URL"}
1248    
1249        $link = {"link_title" => $thing->acc,
1250                 "link" => $link_url};
1251        push(@$links_list,$link);
1252    
1253        my $element_hash = {
1254            "title" => $name_value,
1255            "start" => $thing->start,
1256            "end" =>  $thing->stop,
1257            "color"=> $color,
1258            "zlayer" => '2',
1259            "links_list" => $links_list,
1260            "description" => $descriptions};
1261    
1262        push(@$line_data,$element_hash);
1263        $gd->add_line($line_data, $line_config);
1264    
1265        return $gd;
1266    
1267    }
1268    
1269    sub display_table {
1270        my ($self,$dataset) = @_;
1271        my $cgi = new CGI;
1272        my $data = [];
1273        my $count = 0;
1274        my $content;
1275    
1276        foreach my $thing (@$dataset) {
1277            next if ($thing->type !~ /dom/);
1278            my $single_domain = [];
1279            $count++;
1280    
1281            my $db_and_id = $thing->acc;
1282            my ($db,$id) = split("::",$db_and_id);
1283    
1284            my $dbmaster = DBMaster->new(-database =>'Ontology');
1285    
1286            my ($name_title,$name_value,$description_title,$description_value);
1287            if($db eq "CDD"){
1288                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1289                if(!scalar(@$cdd_objs)){
1290                    $name_title = "name";
1291                    $name_value = "not available";
1292                    $description_title = "description";
1293                    $description_value = "not available";
1294                }
1295                else{
1296                    my $cdd_obj = $cdd_objs->[0];
1297                    $name_title = "name";
1298                    $name_value = $cdd_obj->term;
1299                    $description_title = "description";
1300                    $description_value = $cdd_obj->description;
1301                }
1302            }
1303    
1304            my $location =  $thing->start . " - " . $thing->stop;
1305    
1306            push(@$single_domain,$db);
1307            push(@$single_domain,$thing->acc);
1308            push(@$single_domain,$name_value);
1309            push(@$single_domain,$location);
1310            push(@$single_domain,$thing->evalue);
1311            push(@$single_domain,$description_value);
1312            push(@$data,$single_domain);
1313        }
1314    
1315        if ($count >0){
1316            $content = $data;
1317        }
1318        else
1319        {
1320            $content = "<p>This PEG does not have any similarities to domains</p>";
1321        }
1322    }
1323    
1324    
1325    #########################################
1326    #########################################
1327    package Observation::Location;
1328    
1329    use base qw(Observation);
1330    
1331    sub new {
1332    
1333        my ($class,$dataset) = @_;
1334        my $self = $class->SUPER::new($dataset);
1335        $self->{cleavage_prob} = $dataset->{'cleavage_prob'};
1336        $self->{cleavage_loc} = $dataset->{'cleavage_loc'};
1337        $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'};
1338        $self->{cello_location} = $dataset->{'cello_location'};
1339        $self->{cello_score} = $dataset->{'cello_score'};
1340        $self->{tmpred_score} = $dataset->{'tmpred_score'};
1341        $self->{tmpred_locations} = $dataset->{'tmpred_locations'};
1342        $self->{phobius_signal_location} = $dataset->{'phobius_signal_location'};
1343        $self->{phobius_tm_locations} = $dataset->{'phobius_tm_locations'};
1344    
1345        bless($self,$class);
1346        return $self;
1347    }
1348    
1349    sub display_cello {
1350        my ($thing,$fig) = @_;
1351        my $html;
1352        my $cello_location = $thing->cello_location;
1353        my $cello_score = $thing->cello_score;
1354        if($cello_location){
1355            $html .= "<p><font type=verdana size=-2>Subcellular location  prediction: $cello_location, score: $cello_score</font> </p>";
1356            #$html .= "<p>CELLO score: $cello_score </p>";
1357        }
1358        return ($html);
1359    }
1360    
1361    sub display {
1362        my ($thing,$gd,$fig) = @_;
1363    
1364        my $fid = $thing->fig_id;
1365        #my $fig= new FIG;
1366        my $length = length($fig->get_translation($fid));
1367    
1368        my $cleavage_prob;
1369        if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;}
1370        my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc);
1371        my $signal_peptide_score = $thing->signal_peptide_score;
1372        my $cello_location = $thing->cello_location;
1373        my $cello_score = $thing->cello_score;
1374        my $tmpred_score = $thing->tmpred_score;
1375        my @tmpred_locations = split(",",$thing->tmpred_locations);
1376    
1377        my $phobius_signal_location = $thing->phobius_signal_location;
1378        my @phobius_tm_locations = split(",",$thing->phobius_tm_locations);
1379    
1380        my $lines = [];
1381    
1382        #color is
1383        my $color = "6";
1384    
1385    =pod=
1386    
1387        if($cello_location){
1388            my $cello_descriptions = [];
1389            my $line_data =[];
1390    
1391            my $line_config = { 'title' => 'Localization Evidence',
1392                                'short_title' => 'CELLO',
1393                                'basepair_offset' => '1' };
1394    
1395            my $description_cello_location = {"title" => 'Best Cello Location',
1396                                              "value" => $cello_location};
1397    
1398            push(@$cello_descriptions,$description_cello_location);
1399    
1400            my $description_cello_score = {"title" => 'Cello Score',
1401                                           "value" => $cello_score};
1402    
1403            push(@$cello_descriptions,$description_cello_score);
1404    
1405            my $element_hash = {
1406                "title" => "CELLO",
1407                "color"=> $color,
1408                "start" => "1",
1409                "end" =>  $length + 1,
1410                "zlayer" => '1',
1411                "description" => $cello_descriptions};
1412    
1413            push(@$line_data,$element_hash);
1414            $gd->add_line($line_data, $line_config);
1415        }
1416    
1417        $color = "2";
1418        if($tmpred_score){
1419            my $line_data =[];
1420            my $line_config = { 'title' => 'Localization Evidence',
1421                                'short_title' => 'Transmembrane',
1422                                'basepair_offset' => '1' };
1423    
1424            foreach my $tmpred (@tmpred_locations){
1425                my $descriptions = [];
1426                my ($begin,$end) =split("-",$tmpred);
1427                my $description_tmpred_score = {"title" => 'TMPRED score',
1428                                 "value" => $tmpred_score};
1429    
1430                push(@$descriptions,$description_tmpred_score);
1431    
1432                my $element_hash = {
1433                "title" => "transmembrane location",
1434                "start" => $begin + 1,
1435                "end" =>  $end + 1,
1436                "color"=> $color,
1437                "zlayer" => '5',
1438                "type" => 'box',
1439                "description" => $descriptions};
1440    
1441                push(@$line_data,$element_hash);
1442    
1443            }
1444            $gd->add_line($line_data, $line_config);
1445        }
1446    =cut
1447    
1448        if((scalar(@phobius_tm_locations) > 0) || $phobius_signal_location){
1449            my $line_data =[];
1450            my $line_config = { 'title' => 'Localization Evidence, Transmembrane and Signal Peptide',
1451                                'short_title' => 'TM and SP',
1452                                'basepair_offset' => '1' };
1453    
1454            foreach my $tm_loc (@phobius_tm_locations){
1455                my $descriptions = [];
1456                my $description_phobius_tm_locations = {"title" => 'transmembrane location',
1457                                 "value" => $tm_loc};
1458                push(@$descriptions,$description_phobius_tm_locations);
1459    
1460                my ($begin,$end) =split("-",$tm_loc);
1461    
1462                my $element_hash = {
1463                "title" => "Phobius",
1464                "start" => $begin + 1,
1465                "end" =>  $end + 1,
1466                "color"=> '6',
1467                "zlayer" => '4',
1468                "type" => 'bigbox',
1469                "description" => $descriptions};
1470    
1471                push(@$line_data,$element_hash);
1472    
1473            }
1474    
1475            if($phobius_signal_location){
1476                my $descriptions = [];
1477                my $description_phobius_signal_location = {"title" => 'Phobius Signal Location',
1478                                 "value" => $phobius_signal_location};
1479                push(@$descriptions,$description_phobius_signal_location);
1480    
1481    
1482                my ($begin,$end) =split("-",$phobius_signal_location);
1483                my $element_hash = {
1484                "title" => "phobius signal locations",
1485                "start" => $begin + 1,
1486                "end" =>  $end + 1,
1487                "color"=> '1',
1488                "zlayer" => '5',
1489                "type" => 'box',
1490                "description" => $descriptions};
1491                push(@$line_data,$element_hash);
1492            }
1493    
1494            $gd->add_line($line_data, $line_config);
1495        }
1496    
1497    =head3
1498        $color = "1";
1499        if($signal_peptide_score){
1500            my $line_data = [];
1501            my $descriptions = [];
1502    
1503            my $line_config = { 'title' => 'Localization Evidence',
1504                                'short_title' => 'SignalP',
1505                                'basepair_offset' => '1' };
1506    
1507            my $description_signal_peptide_score = {"title" => 'signal peptide score',
1508                                                    "value" => $signal_peptide_score};
1509    
1510            push(@$descriptions,$description_signal_peptide_score);
1511    
1512            my $description_cleavage_prob = {"title" => 'cleavage site probability',
1513                                             "value" => $cleavage_prob};
1514    
1515            push(@$descriptions,$description_cleavage_prob);
1516    
1517            my $element_hash = {
1518                "title" => "SignalP",
1519                "start" => $cleavage_loc_begin - 2,
1520                "end" =>  $cleavage_loc_end + 1,
1521                "type" => 'bigbox',
1522                "color"=> $color,
1523                "zlayer" => '10',
1524                "description" => $descriptions};
1525    
1526            push(@$line_data,$element_hash);
1527            $gd->add_line($line_data, $line_config);
1528        }
1529    =cut
1530    
1531        return ($gd);
1532    
1533    }
1534    
1535    sub cleavage_loc {
1536      my ($self) = @_;
1537    
1538      return $self->{cleavage_loc};
1539    }
1540    
1541    sub cleavage_prob {
1542      my ($self) = @_;
1543    
1544      return $self->{cleavage_prob};
1545    }
1546    
1547    sub signal_peptide_score {
1548      my ($self) = @_;
1549    
1550      return $self->{signal_peptide_score};
1551    }
1552    
1553    sub tmpred_score {
1554      my ($self) = @_;
1555    
1556      return $self->{tmpred_score};
1557    }
1558    
1559    sub tmpred_locations {
1560      my ($self) = @_;
1561    
1562      return $self->{tmpred_locations};
1563    }
1564    
1565    sub cello_location {
1566      my ($self) = @_;
1567    
1568      return $self->{cello_location};
1569    }
1570    
1571    sub cello_score {
1572      my ($self) = @_;
1573    
1574      return $self->{cello_score};
1575    }
1576    
1577    sub phobius_signal_location {
1578      my ($self) = @_;
1579      return $self->{phobius_signal_location};
1580    }
1581    
1582    sub phobius_tm_locations {
1583      my ($self) = @_;
1584      return $self->{phobius_tm_locations};
1585    }
1586    
1587    
1588    
1589    #########################################
1590    #########################################
1591    package Observation::Sims;
1592    
1593    use base qw(Observation);
1594    
1595    sub new {
1596    
1597        my ($class,$dataset) = @_;
1598        my $self = $class->SUPER::new($dataset);
1599        $self->{identity} = $dataset->{'identity'};
1600        $self->{acc} = $dataset->{'acc'};
1601        $self->{query} = $dataset->{'query'};
1602        $self->{evalue} = $dataset->{'evalue'};
1603        $self->{qstart} = $dataset->{'qstart'};
1604        $self->{qstop} = $dataset->{'qstop'};
1605        $self->{hstart} = $dataset->{'hstart'};
1606        $self->{hstop} = $dataset->{'hstop'};
1607        $self->{database} = $dataset->{'database'};
1608        $self->{organism} = $dataset->{'organism'};
1609        $self->{function} = $dataset->{'function'};
1610        $self->{qlength} = $dataset->{'qlength'};
1611        $self->{hlength} = $dataset->{'hlength'};
1612    
1613        bless($self,$class);
1614        return $self;
1615    }
1616    
1617    =head3 display()
1618    
1619    If available use the function specified here to display a graphical observation.
1620    This code will display a graphical view of the similarities using the genome drawer object
1621    
1622    =cut
1623    
1624    sub display {
1625        my ($self,$gd,$array,$fig) = @_;
1626        #my $fig = new FIG;
1627    
1628        my @ids;
1629        foreach my $thing(@$array){
1630            next if ($thing->class ne "SIM");
1631            push (@ids, $thing->acc);
1632        }
1633    
1634        my %in_subs  = $fig->subsystems_for_pegs(\@ids);
1635    
1636        foreach my $thing (@$array){
1637            if ($thing->class eq "SIM"){
1638    
1639                my $peg = $thing->acc;
1640                my $query = $thing->query;
1641    
1642                my $organism = $thing->organism;
1643                my $genome = $fig->genome_of($peg);
1644                my ($org_tax) = ($genome) =~ /(.*)\./;
1645                my $function = $thing->function;
1646                my $abbrev_name = $fig->abbrev($organism);
1647                my $align_start = $thing->qstart;
1648                my $align_stop = $thing->qstop;
1649                my $hit_start = $thing->hstart;
1650                my $hit_stop = $thing->hstop;
1651    
1652                my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax;
1653    
1654                my $line_config = { 'title' => "$organism [$org_tax]",
1655                                    'short_title' => "$abbrev_name",
1656                                    'title_link' => '$tax_link',
1657                                    'basepair_offset' => '0'
1658                                    };
1659    
1660                my $line_data = [];
1661    
1662                my $element_hash;
1663                my $links_list = [];
1664                my $descriptions = [];
1665    
1666                # get subsystem information
1667                my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg;
1668                my $link;
1669                $link = {"link_title" => $peg,
1670                         "link" => $url_link};
1671                push(@$links_list,$link);
1672    
1673                #my @subsystems = $fig->peg_to_subsystems($peg);
1674                my @subs = @{$in_subs{$peg}} if (defined $in_subs{$peg});
1675                my @subsystems;
1676    
1677                foreach my $array (@subs){
1678                    my $subsystem = $$array[0];
1679                    push(@subsystems,$subsystem);
1680                    my $link;
1681                    $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
1682                             "link_title" => $subsystem};
1683                    push(@$links_list,$link);
1684                }
1685    
1686                $link = {"link_title" => "view blast alignment",
1687                         "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=ToolResult&tool=bl2seq&peg1=$query&peg2=$peg"};
1688                push (@$links_list,$link);
1689    
1690                my $description_function;
1691                $description_function = {"title" => "function",
1692                                         "value" => $function};
1693                push(@$descriptions,$description_function);
1694    
1695                my ($description_ss, $ss_string);
1696                $ss_string = join (",", @subsystems);
1697                $description_ss = {"title" => "subsystems",
1698                                   "value" => $ss_string};
1699                push(@$descriptions,$description_ss);
1700    
1701                my $description_loc;
1702                $description_loc = {"title" => "location start",
1703                                    "value" => $hit_start};
1704                push(@$descriptions, $description_loc);
1705    
1706                $description_loc = {"title" => "location stop",
1707                                    "value" => $hit_stop};
1708                push(@$descriptions, $description_loc);
1709    
1710                my $evalue = $thing->evalue;
1711                while ($evalue =~ /-0/)
1712                {
1713                    my ($chunk1, $chunk2) = split(/-/, $evalue);
1714                    $chunk2 = substr($chunk2,1);
1715                    $evalue = $chunk1 . "-" . $chunk2;
1716                }
1717    
1718                my $color = &color($evalue);
1719    
1720                my $description_eval = {"title" => "E-Value",
1721                                        "value" => $evalue};
1722                push(@$descriptions, $description_eval);
1723    
1724                my $identity = $self->identity;
1725                my $description_identity = {"title" => "Identity",
1726                                            "value" => $identity};
1727                push(@$descriptions, $description_identity);
1728    
1729                $element_hash = {
1730                    "title" => $peg,
1731                    "start" => $align_start,
1732                    "end" =>  $align_stop,
1733                    "type"=> 'box',
1734                    "color"=> $color,
1735                    "zlayer" => "2",
1736                    "links_list" => $links_list,
1737                    "description" => $descriptions
1738                    };
1739                push(@$line_data,$element_hash);
1740                $gd->add_line($line_data, $line_config);
1741            }
1742        }
1743        return ($gd);
1744    }
1745    
1746    =head3 display_domain_composition()
1747    
1748    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
1749    
1750    =cut
1751    
1752    sub display_domain_composition {
1753        my ($self,$gd,$fig) = @_;
1754    
1755        #my $fig = new FIG;
1756        my $peg = $self->acc;
1757    
1758        my $line_data = [];
1759        my $links_list = [];
1760        my $descriptions = [];
1761    
1762        my @domain_query_results =$fig->get_attributes($peg,"CDD");
1763    
1764        foreach $dqr (@domain_query_results){
1765            my $key = @$dqr[1];
1766            my @parts = split("::",$key);
1767            my $db = $parts[0];
1768            my $id = $parts[1];
1769            my $val = @$dqr[2];
1770            my $from;
1771            my $to;
1772            my $evalue;
1773    
1774            if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){
1775                my $raw_evalue = $1;
1776                $from = $2;
1777                $to = $3;
1778                if($raw_evalue =~/(\d+)\.(\d+)/){
1779                    my $part2 = 1000 - $1;
1780                    my $part1 = $2/100;
1781                    $evalue = $part1."e-".$part2;
1782                }
1783                else{
1784                    $evalue = "0.0";
1785                }
1786            }
1787    
1788            my $dbmaster = DBMaster->new(-database =>'Ontology');
1789            my ($name_value,$description_value);
1790    
1791            if($db eq "CDD"){
1792                my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } );
1793                if(!scalar(@$cdd_objs)){
1794                    $name_title = "name";
1795                    $name_value = "not available";
1796                    $description_title = "description";
1797                    $description_value = "not available";
1798                }
1799                else{
1800                    my $cdd_obj = $cdd_objs->[0];
1801                    $name_value = $cdd_obj->term;
1802                    $description_value = $cdd_obj->description;
1803                }
1804            }
1805    
1806            my $domain_name;
1807            $domain_name = {"title" => "name",
1808                     "value" => $name_value};
1809            push(@$descriptions,$domain_name);
1810    
1811            my $description;
1812            $description = {"title" => "description",
1813                            "value" => $description_value};
1814            push(@$descriptions,$description);
1815    
1816            my $score;
1817            $score = {"title" => "score",
1818                      "value" => $evalue};
1819            push(@$descriptions,$score);
1820    
1821            my $link_id = $id;
1822            my $link;
1823            my $link_url;
1824            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"}
1825            elsif($db eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"}
1826            else{$link_url = "NO_URL"}
1827    
1828            $link = {"link_title" => $name_value,
1829                     "link" => $link_url};
1830            push(@$links_list,$link);
1831    
1832            my $domain_element_hash = {
1833                "title" => $peg,
1834                "start" => $from,
1835                "end" =>  $to,
1836                "type"=> 'box',
1837                "zlayer" => '4',
1838                "links_list" => $links_list,
1839                "description" => $descriptions
1840                };
1841    
1842            push(@$line_data,$domain_element_hash);
1843    
1844            #just one CDD domain for now, later will add option for multiple domains from selected DB
1845            last;
1846        }
1847    
1848        my $line_config = { 'title' => $peg,
1849                            'short_title' => $peg,
1850                            'basepair_offset' => '1' };
1851    
1852        $gd->add_line($line_data, $line_config);
1853    
1854        return ($gd);
1855    
1856    }
1857    
1858    =head3 display_table()
1859    
1860    If available use the function specified here to display the "raw" observation.
1861    This code will display a table for the similarities protein
1862    
1863    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.
1864    
1865    =cut
1866    
1867    sub display_table {
1868        my ($self,$dataset, $scroll_list, $query_fid,$lineages,$fig) = @_;
1869    
1870        my $data = [];
1871        my $count = 0;
1872        my $content;
1873        #my $fig = new FIG;
1874        my $cgi = new CGI;
1875        my @ids;
1876        foreach my $thing (@$dataset) {
1877            next if ($thing->class ne "SIM");
1878            push (@ids, $thing->acc);
1879        }
1880    
1881        my (%box_column, %subsystems_column, %evidence_column, %e_identical);
1882        my @attributes = $fig->get_attributes(\@ids);
1883    
1884        # get the column for the subsystems
1885        %subsystems_column = &get_subsystems_column(\@ids,$fig);
1886    
1887        # get the column for the evidence codes
1888        %evidence_column = &get_evidence_column(\@ids, \@attributes,$fig);
1889    
1890        # get the column for pfam_domain
1891        %pfam_column = &get_pfam_column(\@ids, \@attributes,$fig);
1892    
1893        my %e_identical = &get_essentially_identical($query_fid,$dataset,$fig);
1894        my $alias_col = &get_aliases(\@ids,$fig);
1895    
1896        foreach my $thing (@$dataset) {
1897            next if ($thing->class ne "SIM");
1898            my $single_domain = [];
1899            $count++;
1900    
1901            my $id      = $thing->acc;
1902            my $iden    = $thing->identity;
1903            my $ln1     = $thing->qlength;
1904            my $ln2     = $thing->hlength;
1905            my $b1      = $thing->qstart;
1906            my $e1      = $thing->qstop;
1907            my $b2      = $thing->hstart;
1908            my $e2      = $thing->hstop;
1909            my $d1      = abs($e1 - $b1) + 1;
1910            my $d2      = abs($e2 - $b2) + 1;
1911            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
1912            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
1913    
1914            # checkbox column
1915            my $field_name = "tables_" . $id;
1916            my $pair_name = "visual_" . $id;
1917            my $box_col = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1918            my ($tax) = ($id) =~ /fig\|(.*?)\./;
1919    
1920            # get the linked fig id
1921            my $fig_col;
1922            if (defined ($e_identical{$id})){
1923                $fig_col = &HTML::set_prot_links($cgi,$id) . "*";
1924            }
1925            else{
1926                $fig_col = &HTML::set_prot_links($cgi,$id);
1927            }
1928    
1929            push (@$single_domain, $box_col, $fig_col, $thing->evalue,
1930                  "$iden\%", $reg1, $reg2, $thing->organism, $thing->function);   # permanent columns
1931    
1932            foreach my $col (sort keys %$scroll_list){
1933                if ($col =~ /associated_subsystem/)          {push(@$single_domain,$subsystems_column{$id});}
1934                elsif ($col =~ /evidence/)                   {push(@$single_domain,$evidence_column{$id});}
1935                elsif ($col =~ /pfam_domains/)               {push(@$single_domain,$pfam_column{$id});}
1936                elsif ($col =~ /ncbi_id/)                    {push(@$single_domain,$alias_col->{$id}->{"NCBI"});}
1937                elsif ($col =~ /refseq_id/)                  {push(@$single_domain,$alias_col->{$id}->{"RefSeq"});}
1938                elsif ($col =~ /swissprot_id/)               {push(@$single_domain,$alias_col->{$id}->{"SwissProt"});}
1939                elsif ($col =~ /uniprot_id/)                 {push(@$single_domain,$alias_col->{$id}->{"UniProt"});}
1940                elsif ($col =~ /tigr_id/)                    {push(@$single_domain,$alias_col->{$id}->{"TIGR"});}
1941                elsif ($col =~ /pir_id/)                     {push(@$single_domain,$alias_col->{$id}->{"PIR"});}
1942                elsif ($col =~ /kegg_id/)                    {push(@$single_domain,$alias_col->{$id}->{"KEGG"});}
1943                elsif ($col =~ /trembl_id/)                  {push(@$single_domain,$alias_col->{$id}->{"TrEMBL"});}
1944                elsif ($col =~ /asap_id/)                    {push(@$single_domain,$alias_col->{$id}->{"ASAP"});}
1945                elsif ($col =~ /jgi_id/)                     {push(@$single_domain,$alias_col->{$id}->{"JGI"});}
1946                elsif ($col =~ /taxonomy/)                   {push(@$single_domain,$lineages->{$tax});}
1947            }
1948            push(@$data,$single_domain);
1949        }
1950    
1951        if ($count >0 ){
1952            $content = $data;
1953        }
1954        else{
1955            $content = "<p>This PEG does not have any similarities</p>";
1956        }
1957        return ($content);
1958    }
1959    
1960    sub get_box_column{
1961        my ($ids) = @_;
1962        my %column;
1963        foreach my $id (@$ids){
1964            my $field_name = "tables_" . $id;
1965            my $pair_name = "visual_" . $id;
1966            $column{$id} = qq(<input type=checkbox name=seq value="$id" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">);
1967        }
1968        return (%column);
1969    }
1970    
1971    sub get_subsystems_column{
1972        my ($ids,$fig) = @_;
1973    
1974        #my $fig = new FIG;
1975        my $cgi = new CGI;
1976        my %in_subs  = $fig->subsystems_for_pegs($ids);
1977        my %column;
1978        foreach my $id (@$ids){
1979            my @in_sub = @{$in_subs{$id}} if (defined $in_subs{$id});
1980            my @subsystems;
1981    
1982            if (@in_sub > 0) {
1983                foreach my $array(@in_sub){
1984                    my $ss = $$array[0];
1985                    $ss =~ s/_/ /ig;
1986                    push (@subsystems, "-" . $ss);
1987                }
1988                my $in_sub_line = join ("<br>", @subsystems);
1989                $column{$id} = $in_sub_line;
1990            } else {
1991                $column{$id} = "&nbsp;";
1992            }
1993        }
1994        return (%column);
1995    }
1996    
1997    sub get_essentially_identical{
1998        my ($fid,$dataset,$fig) = @_;
1999        #my $fig = new FIG;
2000    
2001        my %id_list;
2002        #my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid);
2003    
2004        foreach my $thing (@$dataset){
2005            if($thing->class eq "IDENTICAL"){
2006                my $rows = $thing->rows;
2007                my $count_identical = 0;
2008                foreach my $row (@$rows) {
2009                    my $id = $row->[0];
2010                    if (($id ne $fid) && ($fig->function_of($id))) {
2011                        $id_list{$id} = 1;
2012                    }
2013                }
2014            }
2015        }
2016    
2017    #    foreach my $id (@maps_to) {
2018    #        if (($id ne $fid) && ($fig->function_of($id))) {
2019    #           $id_list{$id} = 1;
2020    #        }
2021    #    }
2022        return(%id_list);
2023    }
2024    
2025    
2026    sub get_evidence_column{
2027        my ($ids, $attributes,$fig) = @_;
2028        #my $fig = new FIG;
2029        my $cgi = new CGI;
2030        my (%column, %code_attributes);
2031    
2032        my @codes = grep { $_->[1] =~ /^evidence_code/i } @$attributes;
2033        foreach my $key (@codes){
2034            push (@{$code_attributes{$$key[0]}}, $key);
2035        }
2036    
2037        foreach my $id (@$ids){
2038            # add evidence code with tool tip
2039            my $ev_codes=" &nbsp; ";
2040    
2041            my @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2042            my @ev_codes = ();
2043            foreach my $code (@codes) {
2044                my $pretty_code = $code->[2];
2045                if ($pretty_code =~ /;/) {
2046                    my ($cd, $ss) = split(";", $code->[2]);
2047                    $ss =~ s/_/ /g;
2048                    $pretty_code = $cd;# . " in " . $ss;
2049                }
2050                push(@ev_codes, $pretty_code);
2051            }
2052    
2053            if (scalar(@ev_codes) && $ev_codes[0]) {
2054                my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes);
2055                $ev_codes = $cgi->a(
2056                                    {
2057                                        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));
2058            }
2059            $column{$id}=$ev_codes;
2060        }
2061        return (%column);
2062    }
2063    
2064    sub get_pfam_column{
2065        my ($ids, $attributes,$fig) = @_;
2066        #my $fig = new FIG;
2067        my $cgi = new CGI;
2068        my (%column, %code_attributes, %attribute_locations);
2069        my $dbmaster = DBMaster->new(-database =>'Ontology');
2070    
2071        my @codes = grep { $_->[1] =~ /^PFAM/i } @$attributes;
2072        foreach my $key (@codes){
2073            my $name = $key->[1];
2074            if ($name =~ /_/){
2075                ($name) = ($key->[1]) =~ /(.*?)_/;
2076            }
2077            push (@{$code_attributes{$key->[0]}}, $name);
2078            push (@{$attribute_location{$key->[0]}{$name}}, $key->[2]);
2079        }
2080    
2081        foreach my $id (@$ids){
2082            # add evidence code
2083            my $pfam_codes=" &nbsp; ";
2084            my @pfam_codes = "";
2085            my %description_codes;
2086    
2087            if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) {
2088                my @ncodes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}});
2089                @pfam_codes = ();
2090    
2091                # get only unique values
2092                my %saw;
2093                foreach my $key (@ncodes) {$saw{$key}=1;}
2094                @ncodes = keys %saw;
2095    
2096                foreach my $code (@ncodes) {
2097                    my @parts = split("::",$code);
2098                    my $pfam_link = "<a href=http://www.sanger.ac.uk//cgi-bin/Pfam/getacc?" . $parts[1] . ">$parts[1]</a>";
2099    
2100                    # get the locations for the domain
2101                    my @locs;
2102                    foreach my $part (@{$attribute_location{$id}{$code}}){
2103                        my ($loc) = ($part) =~ /\;(.*)/;
2104                        push (@locs,$loc);
2105                    }
2106                    my %locsaw;
2107                    foreach my $key (@locs) {$locsaw{$key}=1;}
2108                    @locs = keys %locsaw;
2109    
2110                    my $locations = join (", ", @locs);
2111    
2112                    if (defined ($description_codes{$parts[1]})){
2113                        push(@pfam_codes, "$parts[1] ($locations)");
2114                    }
2115                    else {
2116                        my $description = $dbmaster->pfam->get_objects( { 'id' => $parts[1] } );
2117                        $description_codes{$parts[1]} = ${$$description[0]}{term};
2118                        push(@pfam_codes, "$pfam_link ($locations)");
2119                    }
2120                }
2121            }
2122    
2123            $column{$id}=join("<br><br>", @pfam_codes);
2124        }
2125        return (%column);
2126    
2127    }
2128    
2129    sub get_aliases {
2130        my ($ids,$fig) = @_;
2131    
2132        my $all_aliases = $fig->feature_aliases_bulk($ids);
2133        foreach my $id (@$ids){
2134            foreach my $alias (@{$$all_aliases{$id}}){
2135                my $id_db = &Observation::get_database($alias);
2136                next if ($aliases->{$id}->{$id_db});
2137                $aliases->{$id}->{$id_db} = &HTML::set_prot_links($cgi,$alias);
2138            }
2139        }
2140        return ($aliases);
2141    }
2142    
2143    sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
2144    
2145    sub color {
2146        my ($evalue) = @_;
2147        my $color;
2148        if ($evalue <= 1e-170){        $color = 51;    }
2149        elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){        $color = 52;    }
2150        elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){        $color = 53;    }
2151        elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){        $color = 54;    }
2152        elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){        $color = 55;    }
2153        elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){        $color = 56;    }
2154        elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){        $color = 57;    }
2155        elsif (($evalue <= 1) && ($evalue > 1e-5)){        $color = 58;    }
2156        elsif (($evalue <= 10) && ($evalue > 1)){        $color = 59;    }
2157        else{        $color = 60;    }
2158        return ($color);
2159    }
2160    
2161    
2162    ############################
2163    package Observation::Cluster;
2164    
2165    use base qw(Observation);
2166    
2167    sub new {
2168    
2169        my ($class,$dataset) = @_;
2170        my $self = $class->SUPER::new($dataset);
2171        $self->{context} = $dataset->{'context'};
2172        bless($self,$class);
2173        return $self;
2174    }
2175    
2176    sub display {
2177        my ($self,$gd,$selected_taxonomies,$taxes,$sims_array,$fig) = @_;
2178    
2179        my $fid = $self->fig_id;
2180        my $compare_or_coupling = $self->context;
2181        my $gd_window_size = $gd->window_size;
2182        my $range = $gd_window_size;
2183        #my $fig = new FIG;
2184        my $all_regions = [];
2185        my $gene_associations={};
2186    
2187        #get the organism genome
2188        my $target_genome = $fig->genome_of($fid);
2189        $gene_associations->{$fid}->{"organism"} = $target_genome;
2190        $gene_associations->{$fid}->{"main_gene"} = $fid;
2191        $gene_associations->{$fid}->{"reverse_flag"} = 0;
2192    
2193        # get location of the gene
2194        my $data = $fig->feature_location($fid);
2195        my ($contig, $beg, $end);
2196        my %reverse_flag;
2197    
2198        if ($data =~ /(.*)_(\d+)_(\d+)$/){
2199            $contig = $1;
2200            $beg = $2;
2201            $end = $3;
2202        }
2203    
2204        my $offset;
2205        my ($region_start, $region_end);
2206        if ($beg < $end)
2207        {
2208            $region_start = $beg - ($range);
2209            $region_end = $end+ ($range);
2210            $offset = ($2+(($3-$2)/2))-($gd_window_size/2);
2211        }
2212        else
2213        {
2214            $region_start = $end-($range);
2215            $region_end = $beg+($range);
2216            $offset = ($3+(($2-$3)/2))-($gd_window_size/2);
2217            $reverse_flag{$target_genome} = $fid;
2218            $gene_associations->{$fid}->{"reverse_flag"} = 1;
2219        }
2220    
2221        # call genes in region
2222        my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end);
2223        push(@$all_regions,$target_gene_features);
2224        my (@start_array_region);
2225        push (@start_array_region, $offset);
2226    
2227        my %all_genes;
2228        my %all_genomes;
2229        foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid; $gene_associations->{$feature}->{"main_gene"}=$fid;}
2230        my @selected_sims;
2231    
2232        if ($compare_or_coupling eq "sims"){
2233            # get the selected boxes
2234            my @selected_taxonomy = @$selected_taxonomies;
2235    
2236            # get the similarities and store only the ones that match the lineages selected
2237            if (@selected_taxonomy > 0){
2238                foreach my $sim (@$sims_array){
2239                    next if ($sim->class ne "SIM");
2240                    next if ($sim->acc !~ /fig\|/);
2241    
2242                    #my $genome = $fig->genome_of($sim->[1]);
2243                    my $genome = $fig->genome_of($sim->acc);
2244                    my ($genome1) = ($genome) =~ /(.*)\./;
2245                    my $lineage = $taxes->{$genome1};
2246                    #my $lineage = $fig->taxonomy_of($fig->genome_of($sim->[1]));
2247                    foreach my $taxon(@selected_taxonomy){
2248                        if ($lineage =~ /$taxon/){
2249                            #push (@selected_sims, $sim->[1]);
2250                            push (@selected_sims, $sim->acc);
2251                        }
2252                    }
2253                }
2254            }
2255            else{
2256                my $simcount = 0;
2257                foreach my $sim (@$sims_array){
2258                    next if ($sim->class ne "SIM");
2259                    next if ($sim->acc !~ /fig\|/);
2260    
2261                    push (@selected_sims, $sim->acc);
2262                    $simcount++;
2263                    last if ($simcount > 4);
2264                }
2265            }
2266    
2267            my %saw;
2268            @selected_sims = grep(!$saw{$_}++, @selected_sims);
2269    
2270            # get the gene context for the sorted matches
2271            foreach my $sim_fid(@selected_sims){
2272                #get the organism genome
2273                my $sim_genome = $fig->genome_of($sim_fid);
2274                $gene_associations->{$sim_fid}->{"organism"} = $sim_genome;
2275                $gene_associations->{$sim_fid}->{"main_gene"} = $sim_fid;
2276                $gene_associations->{$sim_fid}->{"reverse_flag"} = 0;
2277    
2278                # get location of the gene
2279                my $data = $fig->feature_location($sim_fid);
2280                my ($contig, $beg, $end);
2281    
2282                if ($data =~ /(.*)_(\d+)_(\d+)$/){
2283                    $contig = $1;
2284                    $beg = $2;
2285                    $end = $3;
2286                }
2287    
2288                my $offset;
2289                my ($region_start, $region_end);
2290                if ($beg < $end)
2291                {
2292                    $region_start = $beg - ($range/2);
2293                    $region_end = $end+($range/2);
2294                    $offset = ($beg+(($end-$beg)/2))-($gd_window_size/2);
2295                }
2296                else
2297                {
2298                    $region_start = $end-($range/2);
2299                    $region_end = $beg+($range/2);
2300                    $offset = ($end+(($beg-$end)/2))-($gd_window_size/2);
2301                    $reverse_flag{$sim_genome} = $sim_fid;
2302                    $gene_associations->{$sim_fid}->{"reverse_flag"} = 1;
2303                }
2304    
2305                # call genes in region
2306                my ($sim_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($sim_genome, $contig, $region_start, $region_end);
2307                push(@$all_regions,$sim_gene_features);
2308                push (@start_array_region, $offset);
2309                foreach my $feature (@$sim_gene_features){ $all_genes{$feature} = $sim_fid;$gene_associations->{$feature}->{"main_gene"}=$sim_fid;}
2310                $all_genomes{$sim_genome} = 1;
2311            }
2312    
2313        }
2314    
2315        print STDERR "START CLUSTER OF GENES IN COMP REGION: " . `date`;
2316        # cluster the genes
2317        my @all_pegs = keys %all_genes;
2318        my $color_sets = &cluster_genes($fig,\@all_pegs,$fid);
2319        print STDERR "END CLUSTER OF GENES IN COMP REGION: ". `date`;
2320        my %in_subs  = $fig->subsystems_for_pegs(\@all_pegs);
2321    
2322        foreach my $region (@$all_regions){
2323            my $sample_peg = @$region[0];
2324            my $region_genome = $fig->genome_of($sample_peg);
2325            my $region_gs = $fig->genus_species($region_genome);
2326            my $abbrev_name = $fig->abbrev($region_gs);
2327            my ($genome1) = ($region_genome) =~ /(.*?)\./;
2328            my $lineage = $taxes->{$genome1};
2329            #$region_gs .= "Lineage:$lineage";
2330            my $line_config = { 'title' => $region_gs,
2331                                'short_title' => $abbrev_name,
2332                                'basepair_offset' => '0'
2333                                };
2334    
2335            my $offsetting = shift @start_array_region;
2336    
2337            my $second_line_config = { 'title' => "$lineage",
2338                                       'short_title' => "",
2339                                       'basepair_offset' => '0',
2340                                       'no_middle_line' => '1'
2341                                       };
2342    
2343            my $line_data = [];
2344            my $second_line_data = [];
2345    
2346            # initialize variables to check for overlap in genes
2347            my ($prev_start, $prev_stop, $prev_fig, $second_line_flag);
2348            my $major_line_flag = 0;
2349            my $prev_second_flag = 0;
2350    
2351            foreach my $fid1 (@$region){
2352                $second_line_flag = 0;
2353                my $element_hash;
2354                my $links_list = [];
2355                my $descriptions = [];
2356    
2357                my $color = $color_sets->{$fid1};
2358    
2359                # get subsystem information
2360                my $function = $fig->function_of($fid1);
2361                my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1;
2362    
2363                my $link;
2364                $link = {"link_title" => $fid1,
2365                         "link" => $url_link};
2366                push(@$links_list,$link);
2367    
2368                my @subs = @{$in_subs{$fid1}} if (defined $in_subs{$fid1});
2369                my @subsystems;
2370                foreach my $array (@subs){
2371                    my $subsystem = $$array[0];
2372                    my $ss = $subsystem;
2373                    $ss =~ s/_/ /ig;
2374                    push (@subsystems, $ss);
2375                    my $link;
2376                    $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem",
2377                             "link_title" => $ss};
2378                    push(@$links_list,$link);
2379                }
2380    
2381                if ($fid1 eq $fid){
2382                    my $link;
2383                    $link = {"link_title" => "Annotate this sequence",
2384                             "link" => "$FIG_Config::cgi_url/seedviewer.cgi?page=Commentary"};
2385                    push (@$links_list,$link);
2386                }
2387    
2388                my $description_function;
2389                $description_function = {"title" => "function",
2390                                         "value" => $function};
2391                push(@$descriptions,$description_function);
2392    
2393                my $description_ss;
2394                my $ss_string = join (", ", @subsystems);
2395                $description_ss = {"title" => "subsystems",
2396                                   "value" => $ss_string};
2397                push(@$descriptions,$description_ss);
2398    
2399    
2400                my $fid_location = $fig->feature_location($fid1);
2401                if($fid_location =~/(.*)_(\d+)_(\d+)$/){
2402                    my($start,$stop);
2403                    $start = $2 - $offsetting;
2404                    $stop = $3 - $offsetting;
2405    
2406                    if ( (($prev_start) && ($prev_stop) ) &&
2407                         ( ($start < $prev_start) || ($start < $prev_stop) ||
2408                           ($stop < $prev_start) || ($stop < $prev_stop) )){
2409                        if (($second_line_flag == 0) && ($prev_second_flag == 0)) {
2410                            $second_line_flag = 1;
2411                            $major_line_flag = 1;
2412                        }
2413                    }
2414                    $prev_start = $start;
2415                    $prev_stop = $stop;
2416                    $prev_fig = $fid1;
2417    
2418                    if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){
2419                        $start = $gd_window_size - $start;
2420                        $stop = $gd_window_size - $stop;
2421                    }
2422    
2423                    my $title = $fid1;
2424                    if ($fid1 eq $fid){
2425                        $title = "My query gene: $fid1";
2426                    }
2427    
2428                    $element_hash = {
2429                        "title" => $title,
2430                        "start" => $start,
2431                        "end" =>  $stop,
2432                        "type"=> 'arrow',
2433                        "color"=> $color,
2434                        "zlayer" => "2",
2435                        "links_list" => $links_list,
2436                        "description" => $descriptions
2437                    };
2438    
2439                    # if there is an overlap, put into second line
2440                    if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2441                    else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2442    
2443                    if ($fid1 eq $fid){
2444                        $element_hash = {
2445                            "title" => 'Query',
2446                            "start" => $start,
2447                            "end" =>  $stop,
2448                            "type"=> 'bigbox',
2449                            "color"=> $color,
2450                            "zlayer" => "1"
2451                            };
2452    
2453                        # if there is an overlap, put into second line
2454                        if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;}
2455                        else{ push(@$line_data,$element_hash); $prev_second_flag = 0;}
2456                    }
2457                }
2458            }
2459            $gd->add_line($line_data, $line_config);
2460            $gd->add_line($second_line_data, $second_line_config); # if ($major_line_flag == 1);
2461        }
2462        return ($gd, \@selected_sims);
2463    }
2464    
2465    sub cluster_genes {
2466        my($fig,$all_pegs,$peg) = @_;
2467        my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
2468    
2469        my @color_sets = ();
2470    
2471        $conn = &get_connections_by_similarity($fig,$all_pegs);
2472    
2473        for ($i=0; ($i < @$all_pegs); $i++) {
2474            if ($all_pegs->[$i] eq $peg) { $pegI = $i }
2475            if (! $seen{$i}) {
2476                $cluster = [$i];
2477                $seen{$i} = 1;
2478                for ($j=0; ($j < @$cluster); $j++) {
2479                    $x = $conn->{$cluster->[$j]};
2480                    foreach $k (@$x) {
2481                        if (! $seen{$k}) {
2482                            push(@$cluster,$k);
2483                            $seen{$k} = 1;
2484                        }
2485                    }
2486                }
2487    
2488                if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
2489                    push(@color_sets,$cluster);
2490                }
2491            }
2492        }
2493        for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
2494        $red_set = $color_sets[$i];
2495        splice(@color_sets,$i,1);
2496        @color_sets = sort { @$b <=> @$a } @color_sets;
2497        unshift(@color_sets,$red_set);
2498    
2499        my $color_sets = {};
2500        for ($i=0; ($i < @color_sets); $i++) {
2501            foreach $x (@{$color_sets[$i]}) {
2502                $color_sets->{$all_pegs->[$x]} = $i;
2503            }
2504        }
2505        return $color_sets;
2506    }
2507    
2508    sub get_connections_by_similarity {
2509        my($fig,$all_pegs) = @_;
2510        my($i,$j,$tmp,$peg,%pos_of);
2511        my($sim,%conn,$x,$y);
2512    
2513        for ($i=0; ($i < @$all_pegs); $i++) {
2514            $tmp = $fig->maps_to_id($all_pegs->[$i]);
2515            push(@{$pos_of{$tmp}},$i);
2516            if ($tmp ne $all_pegs->[$i]) {
2517                push(@{$pos_of{$all_pegs->[$i]}},$i);
2518            }
2519        }
2520    
2521        foreach $y (keys(%pos_of)) {
2522            $x = $pos_of{$y};
2523            for ($i=0; ($i < @$x); $i++) {
2524                for ($j=$i+1; ($j < @$x); $j++) {
2525                    push(@{$conn{$x->[$i]}},$x->[$j]);
2526                    push(@{$conn{$x->[$j]}},$x->[$i]);
2527                }
2528            }
2529        }
2530    
2531        for ($i=0; ($i < @$all_pegs); $i++) {
2532            foreach $sim ($fig->nsims($all_pegs->[$i],500,10,"raw")) {
2533                if (defined($x = $pos_of{$sim->id2})) {
2534                    foreach $y (@$x) {
2535                        push(@{$conn{$i}},$y);
2536                    }
2537                }
2538            }
2539        }
2540        return \%conn;
2541    }
2542    
2543    sub in {
2544        my($x,$xL) = @_;
2545        my($i);
2546    
2547        for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
2548        return ($i < @$xL);
2549    }
2550    
2551    #############################################
2552    #############################################
2553    package Observation::Commentary;
2554    
2555    use base qw(Observation);
2556    
2557    =head3 display_protein_commentary()
2558    
2559    =cut
2560    
2561    sub display_protein_commentary {
2562        my ($self,$dataset,$mypeg,$fig) = @_;
2563    
2564        my $all_rows = [];
2565        my $content;
2566        #my $fig = new FIG;
2567        my $cgi = new CGI;
2568        my $count = 0;
2569        my $peg_array = [];
2570        my (%evidence_column, %subsystems_column,  %e_identical);
2571    
2572        if (@$dataset != 1){
2573            foreach my $thing (@$dataset){
2574                if ($thing->class eq "SIM"){
2575                    push (@$peg_array, $thing->acc);
2576                }
2577            }
2578            # get the column for the evidence codes
2579            %evidence_column = &Observation::Sims::get_evidence_column($peg_array);
2580    
2581            # get the column for the subsystems
2582            %subsystems_column = &Observation::Sims::get_subsystems_column($peg_array,$fig);
2583    
2584            # get essentially identical seqs
2585            %e_identical = &Observation::Sims::get_essentially_identical($mypeg,$dataset,$fig);
2586        }
2587        else{
2588            push (@$peg_array, @$dataset);
2589        }
2590    
2591        my $selected_sims = [];
2592        foreach my $id (@$peg_array){
2593            last if ($count > 10);
2594            my $row_data = [];
2595            my ($set, $org, $ss, $ev, $function, $function_cell, $id_cell);
2596            $org = $fig->org_of($id);
2597            $function = $fig->function_of($id);
2598            if ($mypeg ne $id){
2599                $function_cell = qq(<input type=radio name=function id=$id value=$id onClick="clearText('newAnnotation');">&nbsp;&nbsp;$function);
2600                $id_cell .= &HTML::set_prot_links($cgi,$id);
2601                if (defined($e_identical{$id})) { $id_cell .= "*";}
2602            }
2603            else{
2604                $function_cell = "&nbsp;&nbsp;$function";
2605                $id_cell = "<input type=checkbox name=peg id=peg$count value=$id checked=true>";
2606                $id_cell .= &HTML::set_prot_links($cgi,$id);
2607            }
2608    
2609            push(@$row_data,$id_cell);
2610            push(@$row_data,$org);
2611            push(@$row_data, $subsystems_column{$id}) if ($mypeg ne $id);
2612            push(@$row_data, $evidence_column{$id}) if ($mypeg ne $id);
2613            push(@$row_data, $fig->translation_length($id));
2614            push(@$row_data,$function_cell);
2615            push(@$all_rows,$row_data);
2616            push (@$selected_sims, $id);
2617            $count++;
2618        }
2619    
2620        if ($count >0){
2621            $content = $all_rows;
2622        }
2623        else{
2624            $content = "<p>This PEG does not have enough similarities to change the commentary</p>";
2625        }
2626        return ($content,$selected_sims);
2627    }
2628    
2629    sub display_protein_history {
2630        my ($self, $id,$fig) = @_;
2631        my $all_rows = [];
2632        my $content;
2633    
2634        my $cgi = new CGI;
2635        my $count = 0;
2636        foreach my $feat ($fig->feature_annotations($id)){
2637            my $row = [];
2638            my $col1 = $feat->[2];
2639            my $col2 = $feat->[1];
2640            #my $text = "<pre>" . $feat->[3] . "<\pre>";
2641            my $text = $feat->[3];
2642    
2643            push (@$row, $col1);
2644            push (@$row, $col2);
2645            push (@$row, $text);
2646            push (@$all_rows, $row);
2647            $count++;
2648        }
2649        if ($count > 0){
2650            $content = $all_rows;
2651        }
2652        else {
2653            $content = "There is no history for this PEG";
2654        }
2655    
2656        return($content);
2657    }

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.41

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3