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

Diff of /FigWebServices/diagram.cgi

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

revision 1.2, Fri Feb 16 22:29:47 2007 UTC revision 1.3, Fri Mar 2 18:03:18 2007 UTC
# Line 19  Line 19 
19    
20  use strict;  use strict;
21  use warnings;  use warnings;
22    no warnings qw( numeric ); # variant code comparison with >
23    
24  use FIG_CGI;  use FIG_CGI;
25  use FIG_Config;  use FIG_Config;
# Line 70  Line 71 
71      # get parameters      # get parameters
72      my ($fig, $cgi) = @_;      my ($fig, $cgi) = @_;
73    
74      unless ($cgi->param('subsystem_name') and      # get the subsystem
75              $cgi->param('diagram')) {      unless ($cgi->param('subsystem_name')) {
76          return '<p>CGI Parameter missing.</p>';          return '<p>CGI Parameter missing.</p>';
77      }      }
78        my $subsystem_name = $cgi->param('subsystem_name') || '';
     my $subsystem_name = $cgi->param('subsystem_name');  
     my $diagram_id  = $cgi->param('diagram');  
   
79      my $subsystem_pretty = $subsystem_name;      my $subsystem_pretty = $subsystem_name;
80      $subsystem_pretty =~ s/_/ /g;      $subsystem_pretty =~ s/_/ /g;
   
81      my $subsystem = $fig->get_subsystem($subsystem_name);      my $subsystem = $fig->get_subsystem($subsystem_name);
     my @genomes = $subsystem->get_genomes();  
     my $genome = $cgi->param('genome_id');  
     my %genome_labels = map { $_ => $fig->genus_species($_)." ( $_ )" } @genomes;  
82    
83      # generate the content      # check subsystem
84      my $content = '<p>No subsystem name given.</p>';      unless ($subsystem) {
85      if ($subsystem) {          return "<p>Unable to find a subsystem called '$subsystem_name'.</p>";
86        }
87    
         $content = "<h1>Subsystem: $subsystem_pretty</h1>";  
         $content .= '<hr/>';  
88    
89        # if diagram.cgi is called without the CGI param diagram (the diagram id)
90        # it will try to load the first 'new' diagram from the subsystem and
91        # print out an error message if there is no 'new' diagram
92        my $diagram_id  = $cgi->param('diagram') || '';
93        unless ($diagram_id) {
94            foreach my $d ($subsystem->get_diagrams) {
95                my ($id) = @$d;
96                if ($subsystem->is_new_diagram($id)) {
97                    $diagram_id = $id;
98                    last;
99                }
100            }
101        }
102    
103        # check diagram id
104        unless ($diagram_id) {
105            return "<h1>Subsystem: $subsystem_pretty</h1>".
106                "<p><em>Unable to find a diagram for this subsystem.</em><p>";
107        }
108          unless ($subsystem->is_new_diagram($diagram_id)) {          unless ($subsystem->is_new_diagram($diagram_id)) {
109              $content .= "<p><em>Diagram '$diagram_id' is not a new diagram.</em><p>";          return "<h1>Subsystem: $subsystem_pretty</h1>".
110              return $content;              "<p><em>Diagram '$diagram_id' is not a new diagram.</em><p>";
111          }          }
112    
113    
114        # get the genomes from the subsystem with positive variant codes
115        my @genomes;
116        my $genome = $cgi->param('genome_id');
117        foreach (sort { $fig->genus_species($a) cmp $fig->genus_species($b) } $subsystem->get_genomes()) {
118            my $vcode = $subsystem->get_variant_code( $subsystem->get_genome_index( $_ ) );
119            push @genomes, $_ if ($vcode > 0);
120        }
121    
122        my %genome_labels = map { $_ => $fig->genus_species($_)." ( $_ )" } @genomes;
123    
124    
125        # generate the content
126        my $content = "<h1>Subsystem: $subsystem_pretty</h1>";
127        $content .= '<hr/>';
128    
129          $content .= $cgi->start_form();          $content .= $cgi->start_form();
130          $content .= $cgi->hidden( -name  => 'subsystem_name',          $content .= $cgi->hidden( -name  => 'subsystem_name',
131                                    -value => $subsystem_name );                                    -value => $subsystem_name );
# Line 122  Line 150 
150          # DEBUG: test all items of the diagram against the subsystem          # DEBUG: test all items of the diagram against the subsystem
151          # (for debug purposes during introduction of new diagrams)          # (for debug purposes during introduction of new diagrams)
152          # (remove when no longer needed)          # (remove when no longer needed)
153        # (1) roles
154          my $types = [ 'role', 'role_and', 'role_or' ];          my $types = [ 'role', 'role_and', 'role_or' ];
155          foreach my $t (@$types) {          foreach my $t (@$types) {
156              foreach my $id (@{$d->item_ids_of_type($t)}) {              foreach my $id (@{$d->item_ids_of_type($t)}) {
# Line 131  Line 160 
160                  }                  }
161              }              }
162          }          }
163        # (2) subsystem
164        foreach my $s (@{$d->item_ids_of_type('subsystem')}) {
165            unless ($fig->subsystem_version($s)) {
166                $status .= "Diagram item 'subsystem' = '$s' is not a subsystem.\n";
167            }
168        }
169          # END          # END
170    
171          if ($genome) {          if ($genome) {
# Line 189  Line 224 
224                  shift(@roles);                  shift(@roles);
225              }              }
226              else {              else {
227                  $content .= "<p><em>Showing colours for genome: $genome.</em><p>";              $content .= "<p><em>Showing colors for genome: $genome.</em><p>";
228              }              }
229    
230    
# Line 234  Line 269 
269          $content .= '<hr/><p><em>Below follows a status message to help test the new diagrams:</em><p>'.          $content .= '<hr/><p><em>Below follows a status message to help test the new diagrams:</em><p>'.
270              "<pre>$status</pre>" if ($status);              "<pre>$status</pre>" if ($status);
271    
     }  
   
272      return $content;      return $content;
273  }  }
274    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3