[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.3, Fri Mar 2 18:03:18 2007 UTC revision 1.5, Tue Mar 6 16:39:39 2007 UTC
# Line 119  Line 119 
119          push @genomes, $_ if ($vcode > 0);          push @genomes, $_ if ($vcode > 0);
120      }      }
121    
122      my %genome_labels = map { $_ => $fig->genus_species($_)." ( $_ )" } @genomes;      my %genome_labels = map { $_ => $fig->genus_species($_)." ( $_ ) [".
123                                      $subsystem->get_variant_code( $subsystem->get_genome_index( $_ ) )."]"
124                                } @genomes;
125    
126    
127      # generate the content      # generate the content
# Line 131  Line 133 
133                                -value => $subsystem_name );                                -value => $subsystem_name );
134      $content .= $cgi->hidden( -name  => 'diagram',      $content .= $cgi->hidden( -name  => 'diagram',
135                                -value => $diagram_id );                                -value => $diagram_id );
136        $content .= $cgi->hidden( -name  => 'dont_scale', -value => 1 )
137            if ($cgi->param('dont_scale'));
138        $content .= $cgi->hidden( -name  => 'debug', -value => 1 )
139            if ($cgi->param('debug'));
140      $content .= $cgi->popup_menu( -name    => 'genome_id',      $content .= $cgi->popup_menu( -name    => 'genome_id',
141                                    -values  => \@genomes,                                    -values  => \@genomes,
142                                    -default => $genome,                                    -default => $genome,
# Line 146  Line 152 
152      my $diagram_dir = $subsystem->{dir}."/diagrams/$diagram_id/";      my $diagram_dir = $subsystem->{dir}."/diagrams/$diagram_id/";
153      my $d = Diagram->new($subsystem_name, $diagram_dir);      my $d = Diagram->new($subsystem_name, $diagram_dir);
154    
155        # turn off scaling?
156        $d->min_scale(1) if ($cgi->param('dont_scale'));
157    
158    
159      # DEBUG: test all items of the diagram against the subsystem      # DEBUG: test all items of the diagram against the subsystem
160      # (for debug purposes during introduction of new diagrams)      # (for debug purposes during introduction of new diagrams)
# Line 168  Line 177 
177      }      }
178      # END      # END
179    
     if ($genome) {  
   
         my @roles = $subsystem->get_roles_for_genome($genome);  
   
180          # build a lookup hash, make one entry for each role_and and role_or item          # build a lookup hash, make one entry for each role_and and role_or item
181          # the index references to the inner hash of the role_and/role_or hash          # the index references to the inner hash of the role_and/role_or hash
182          # to set a value there use $lookup->{role_abbr}->{role_abbr} = 1;          # to set a value there use $lookup->{role_abbr}->{role_abbr} = 1;
183        # declared outside if to be available for debug output
184          my $lookup = {};          my $lookup = {};
185    
186        if ($genome) {
187    
188            my @roles = $subsystem->get_roles_for_genome($genome);
189    
190          # find out about role_and          # find out about role_and
191          my $role_and = {};          my $role_and = {};
192          if (scalar(@{$d->item_ids_of_type('role_and')})) {          if (scalar(@{$d->item_ids_of_type('role_and')})) {
# Line 205  Line 215 
215    
216                  foreach my $r ($subsystem->get_subsetC_roles($subset)) {                  foreach my $r ($subsystem->get_subsetC_roles($subset)) {
217                      my $r_abbr = $subsystem->get_abbr_for_role($r);                      my $r_abbr = $subsystem->get_abbr_for_role($r);
218    
219                      unless ($r_abbr) {                      unless ($r_abbr) {
220                          die "Unable to get the abbreviation for role '$r'.";                          die "Unable to get the abbreviation for role '$r'.";
221                      }                      }
222    
223                      $lookup->{$r_abbr} = $role_and->{$subset};                      $lookup->{$r_abbr} = $role_or->{$subset};
224                      $role_or->{$subset}->{$r_abbr} = 0;                      $role_or->{$subset}->{$r_abbr} = 0;
225                  }                  }
226              }              }
# Line 224  Line 235 
235              shift(@roles);              shift(@roles);
236          }          }
237          else {          else {
238              $content .= "<p><em>Showing colors for genome: $genome.</em><p>";              $content .= "<p><em>Showing colors for genome: ".
239                    $fig->genus_species($genome)." ( $genome ), variant code ".
240                    $subsystem->get_variant_code($subsystem->get_genome_index($genome)) ."</em><p>";
241          }          }
242    
243    
# Line 249  Line 262 
262              $status .= "Role '$_' not found in the diagram.\n";              $status .= "Role '$_' not found in the diagram.\n";
263          }          }
264    
         # use Data::Dumper;  
         # $content .= "<pre>".Data::Dumper->Dump([ $lookup ])."</pre>";  
   
265          # check if to color any role_and          # check if to color any role_and
266          foreach my $id_role_and (keys(%$role_and)) {          foreach my $id_role_and (keys(%$role_and)) {
267              my $result = 1;              my $result = 1;
# Line 260  Line 270 
270              }              }
271              $d->color_item('role_and', $id_role_and, 'green') if ($result);              $d->color_item('role_and', $id_role_and, 'green') if ($result);
272          }          }
273    
274            # check if to color any role_or
275            foreach my $id_role_or (keys(%$role_or)) {
276                foreach (keys(%{$role_or->{$id_role_or}})) {
277                    if ($role_or->{$id_role_or}->{$_}) {
278                        $d->color_item('role_or', $id_role_or, 'green');
279                        last;
280                    }
281                }
282            }
283    
284      }      }
285      else {      else {
286          $content .= '<p><em>You have not provided a genome id to color the diagram with.</em><p>';          $content .= '<p><em>You have not provided a genome id to color the diagram with.</em><p>';
287      }      }
288    
289        # add an info line about diagram scaling
290        my $scale = $d->calculate_scale * 100;
291        unless ($scale == 100) {
292            $content .= '<p><em>This diagram has been scaled to '.sprintf("%.2f", $scale).'%. ';
293            $content .= "(<a href='?subsystem_name=$subsystem_name&diagram_id=$diagram_id&dont_scale=1'>".
294                "view in original size</a>)";
295            $content .= '</em></p>';
296        }
297        if ($cgi->param('dont_scale')) {
298            $content .= '<p><em>You have switched off scaling this diagram down. ';
299            $content .= "(<a href='?subsystem_name=$subsystem_name&diagram_id=$diagram_id'>".
300                "Allow scaling</a>)";
301            $content .= '</em></p>';
302        }
303    
304        # print diagram
305      $content .= $d->html;      $content .= $d->html;
306    
307        # print status
308      $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>'.
309          "<pre>$status</pre>" if ($status);          "<pre>$status</pre>" if ($status);
310    
311        # print debug
312        if ($cgi->param('debug')) {
313            require Data::Dumper;
314            $content .= '<hr/>';
315            $content .= "<h2>Diagram dump:</h2><pre>".Data::Dumper->Dump([ $d ])."</pre>";
316            $content .= "<h2>Lookup dump:</h2><pre>".Data::Dumper->Dump([ $lookup ])."</pre>";
317        }
318    
319      return $content;      return $content;
320  }  }
321    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3