[Bio] / SubsystemEditor / WebPage / ShowIllustrations.pm Repository:
ViewVC logotype

Annotation of /SubsystemEditor/WebPage/ShowIllustrations.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (view) (download) (as text)

1 : bartels 1.1 package SubsystemEditor::WebPage::ShowIllustrations;
2 :    
3 :     use strict;
4 :     use warnings;
5 :     use URI::Escape;
6 :     use HTML;
7 :     use Data::Dumper;
8 :     use WebComponent::WebGD;
9 :    
10 :     use FIG;
11 :    
12 :     use constant ROLE => ''; # 'index.cgi?action=ShowFunctionalRole&subsystem_name=<SUBSYSTEM>&role_abbr=<ROLE>';
13 :     use constant SUBSYSTEM => 'diagram.cgi?subsystem_name=<SUBSYSTEM>';
14 :     use constant MAX_WIDTH => 800;
15 :     use constant MAX_HEIGHT => 700;
16 :     use constant MIN_SCALE => 0.65;
17 :    
18 :     use base qw( WebPage );
19 :    
20 :     1;
21 :    
22 :     ##################################################
23 :     # Method for registering components etc. for the #
24 :     # application #
25 :     ##################################################
26 :     sub init {
27 :     my ( $self ) = @_;
28 :     }
29 :    
30 :     sub require_javascript {
31 :    
32 :     return [ './Html/showfunctionalroles.js' ];
33 :    
34 :     }
35 :    
36 :     ##############################################
37 :     # Website content is returned by this method #
38 :     ##############################################
39 :     sub output {
40 :     my ( $self ) = @_;
41 :    
42 :     my $fig = new FIG;
43 :     my $cgi = $self->application->cgi;
44 :    
45 :     my $name = $cgi->param( 'subsystem' );
46 :     my $ssname = $name;
47 :     $ssname =~ s/\_/ /g;
48 :    
49 : bartels 1.5 my $esc_name = uri_escape($name);
50 :    
51 : bartels 1.3 my $subsystem = new Subsystem( $name, $fig, 0 );
52 :    
53 : bartels 1.1 # look if someone is logged in and can write the subsystem #
54 :     my $can_alter = 0;
55 :     my $user = $self->application->session->user;
56 :     if ( $user && $user->has_right( $self->application, 'edit', 'subsystem', $name ) ) {
57 :     $can_alter = 1;
58 :     }
59 :    
60 :     ######################
61 :     # Construct the menu #
62 :     ######################
63 :    
64 :     my $menu = $self->application->menu();
65 :    
66 :     # Build nice tab menu here
67 : bartels 1.5 $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$esc_name" );
68 :     $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$esc_name" );
69 : bartels 1.6 $menu->add_category( 'Subsets', "SubsysEditor.cgi?page=ShowSubsets&subsystem=$esc_name" );
70 : redwards 1.7 $menu->add_category( 'Diagrams and Illustrations' );
71 :     $menu->add_entry( 'Diagrams and Illustrations', 'Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$esc_name" );
72 :     $menu->add_entry( 'Diagrams and Illustrations', 'Illustrations', "SubsysEditor.cgi?page=ShowIllustrations&subsystem=$esc_name" );
73 : bartels 1.5 $menu->add_category( 'Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$esc_name" );
74 :     $menu->add_category( 'Show Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$esc_name" );
75 :     $menu->add_category( 'Show Connections', "SubsysEditor.cgi?page=ShowTree&subsystem=$esc_name" );
76 : bartels 1.1
77 :     my $error = '';
78 :     my $comment = '';
79 :    
80 : bartels 1.3 #########
81 :     # TASKS #
82 :     #########
83 :    
84 :     if ( defined( $cgi->param( 'DELETEBUTTONPRESSED' ) ) && $cgi->param( 'DELETEBUTTONPRESSED' ) == 1 ) {
85 :     my $diagramid = $cgi->param( 'DIAGRAMID' );
86 :     &delete_illustration( $subsystem, $diagramid );
87 :     $cgi->delete( 'diagram' );
88 :     $cgi->delete( 'DIAGRAMID' );
89 :     $cgi->delete( 'diagram_selectbox' );
90 :     }
91 :    
92 : bartels 1.1 ##############################
93 :     # Construct the page content #
94 :     ##############################
95 :    
96 :     my $content = "<H1>Subsystem Illustrations: $ssname</H1>";
97 :     $content .= "<P>Illustrations are general diagrams related to the subsystem that cannot be colored.</P>";
98 :    
99 :     my $diagram = $self->get_Diagram( $fig, $cgi, $can_alter );
100 :    
101 :     $content .= $diagram;
102 :    
103 :    
104 :     ###############################
105 :     # Display errors and comments #
106 :     ###############################
107 :    
108 :     if ( defined( $error ) && $error ne '' ) {
109 :     $self->application->add_message( 'warning', $error );
110 :     }
111 :     if ( defined( $comment ) && $comment ne '' ) {
112 :     $self->application->add_message( 'info', $comment );
113 :     }
114 :    
115 :     return $content;
116 :     }
117 :    
118 :    
119 :     sub get_data {
120 :    
121 :     my ( $fig, $subsystem_name ) = @_;
122 :     my $subsystem = $fig->get_subsystem( $subsystem_name );
123 :    
124 :     my $default_diagram;
125 :     my $newDiagrams;
126 :    
127 :     foreach my $d ( $subsystem->get_diagrams ) {
128 :     my ( $id, $name ) = @$d;
129 :     unless ( $subsystem->is_new_diagram( $id ) ) {
130 :     $newDiagrams->{ $id }->{ 'name' } = $name;
131 :     if ( !defined( $default_diagram ) ) {
132 :     $default_diagram = $id;
133 :     }
134 :     }
135 :     }
136 :    
137 :     return ( $subsystem, $newDiagrams, $default_diagram );
138 :     }
139 :    
140 :     sub get_Diagram {
141 :     my ( $self, $fig, $cgi, $can_alter ) = @_;
142 :    
143 :     # get the subsystem
144 :     unless ( $cgi->param( 'subsystem' ) ) {
145 :     return '<p>CGI Parameter missing.</p>';
146 :     }
147 :     my $subsystem_name = $cgi->param( 'subsystem' ) || '';
148 :     my $subsystem_pretty = $subsystem_name;
149 :     $subsystem_pretty =~ s/_/ /g;
150 :     my ( $subsystem, $newDiagrams, $defaultDiagram ) = get_data( $fig, $subsystem_name );
151 :    
152 : bartels 1.5 my $esc_name = uri_escape($subsystem_name);
153 :    
154 : bartels 1.1 # check subsystem
155 :     unless ( $subsystem ) {
156 :     return "<p>Unable to find a subsystem called '$subsystem_name'.</p>";
157 :     }
158 :    
159 :     #####################################
160 :     # get values for attribute coloring #
161 :     #####################################
162 :    
163 :     my $color_by_attribute = 0;
164 :     my $attribute = $cgi->param( 'attribute_selectbox' );
165 :    
166 :    
167 :     # if diagram.cgi is called without the CGI param diagram (the diagram id)
168 :     # it will try to load the first 'new' diagram from the subsystem and
169 :     # print out an error message if there is no 'new' diagram
170 :     my $diagram_id = $cgi->param( 'diagram' ) || $cgi->param( 'diagram_selectbox' ) || '';
171 :    
172 : bartels 1.3 if ( defined( $cgi->param( 'Show this illustration' ) ) ) {
173 : bartels 1.1 $diagram_id = $cgi->param( 'diagram_selectbox' );
174 :     }
175 :    
176 :     unless ( $diagram_id ) {
177 :     $diagram_id = $defaultDiagram;
178 : bartels 1.3 $cgi->param( 'diagram_selectbox', $diagram_id );
179 : bartels 1.1 }
180 :    
181 :     # check diagram id
182 :     my $errortext = '';
183 :    
184 :     if ( !( $diagram_id ) ) {
185 :     $errortext .= "<p><em>Unable to find a diagram for this subsystem.</em><p>";
186 :     }
187 :    
188 :     # initialise a status string (log)
189 :     my $status = '';
190 :    
191 :     # generate the content
192 :     my $content = $errortext;
193 :    
194 :     # start form #
195 :     $content .= $self->start_form( 'diagram_select_genome' );
196 :     $content .= "<TABLE><TR><TD>";
197 :    
198 :     my $choose = build_show_other_diagram( $fig, $cgi, $subsystem, $newDiagrams, $diagram_id );
199 :    
200 :     my $scale = 1;
201 :    
202 :     $content .= "<DIV id='controlpanel'>$choose</DIV></TD><TR><TR><TD>";
203 :    
204 :     if ( $diagram_id ) {
205 : bartels 1.3
206 : bartels 1.1 # fetch the diagram
207 :     my $diagram_dir = $subsystem->{dir}."/diagrams/$diagram_id/";
208 :    
209 : bartels 1.3 if ( !( -d $diagram_dir ) ) {
210 :     $errortext .= "<P>The given diagram can not be found</P>";
211 :     }
212 :    
213 : bartels 1.1 my $d = $diagram_dir;
214 :     if ( -f $diagram_dir.'diagram.png' ) {
215 :     $d = $diagram_dir.'diagram.png';
216 :     }
217 :     elsif ( -f $diagram_dir.'diagram.jpg' ) {
218 :     $d = $diagram_dir.'diagram.jpg';
219 :     }
220 :     elsif ( -f $diagram_dir.'diagram.gif' ) {
221 :     $d = $diagram_dir.'diagram.gif';
222 :     }
223 :    
224 :     # print diagram
225 : redwards 1.8 my $image = WebGD->new( $d );
226 :    
227 :    
228 : bartels 1.1 my ( $width, $height ) = ( $image->getBounds() );
229 :    
230 :     unless ( $cgi->param( 'dont_scale' ) ) {
231 :     ( $scale, $width, $height ) = calculate_scale( $width, $height );
232 :     }
233 :    
234 :     $content .= "<DIV><IMG SRC=\"".$image->image_src()."\" width=$width height=$height></DIV>";
235 :    
236 :     # add an info line about diagram scaling
237 :     my $scaling_info;
238 : bartels 1.3 if ( $scale == 1 ) {
239 : bartels 1.1 $scaling_info .= '<p><em>This diagram is not scaled.</em></p>';
240 :     }
241 :     else {
242 : bartels 1.3 $scaling_info .= '<p><em>This diagram has been scaled to '.$scale.'%. ';
243 : bartels 1.5 $scaling_info .= "(<a href='".$self->application->url()."?page=ShowIllustrations&subsystem=$esc_name&diagram=$diagram_id&dont_scale=1'>".
244 : bartels 1.1 "view in original size</a>)";
245 :     $scaling_info .= '</em></p>';
246 :     }
247 :     if ( $cgi->param( 'dont_scale' ) ) {
248 :     $scaling_info .= '<p><em>You have switched off scaling this diagram down. ';
249 : bartels 1.5 $scaling_info .= "(<a href='".$self->application->url()."?page=ShowIllustrations&subsystem=$esc_name&diagram=$diagram_id'>".
250 : bartels 1.1 "Allow scaling</a>)";
251 :     $scaling_info .= '</em></p>';
252 :     }
253 :    
254 :     $content .= "</TD></TR><TR><TD>$scaling_info</TD></TR>";
255 :     }
256 :    
257 :     $content .= "<TR><TD><DIV id='controlpanel'>$choose";
258 :    
259 :     # upload diagram only if can_alter #
260 :     if ( $can_alter ) {
261 : bartels 1.5 my $upload = $self->build_upload_diagram( $fig, $esc_name );
262 : bartels 1.1 $content .= "$upload";
263 : bartels 1.3
264 :     my $delete = '';
265 :     if ( defined( $diagram_id ) ) {
266 : bartels 1.5 $delete = $self->build_delete_diagram( $fig, $esc_name, $diagram_id );
267 : bartels 1.3 $content .= "$delete";
268 :     }
269 : bartels 1.1 }
270 :    
271 :     $content .= "</DIV></TD><TR></TABLE>";
272 :    
273 :     # hiddens for subsystem, diagram, scale #
274 :     $content .= $cgi->hidden( -name => 'subsystem',
275 : bartels 1.5 -value => $esc_name );
276 : bartels 1.1 $content .= $cgi->hidden( -name => 'diagram',
277 :     -value => $diagram_id );
278 :    
279 :     $content .= $cgi->hidden( -name => 'dont_scale', -value => 1 )
280 :     if ( $cgi->param( 'dont_scale' ) );
281 :    
282 :     $content .= $self->end_form();
283 :    
284 :     return $content;
285 :     }
286 :    
287 :     #######################################
288 :     # build the little show other diagram #
289 :     #######################################
290 :     sub build_show_other_diagram {
291 :    
292 :     my ( $fig, $cgi, $subsystem, $diagrams, $default ) = @_;
293 :    
294 :     my $default_num;
295 :    
296 :     my @ids = sort keys %$diagrams;
297 :     my %names;
298 :     my $counter = 0;
299 :     foreach ( @ids ) {
300 :     if ( $_ eq $default ) {
301 :     $default_num = $counter;
302 :     }
303 :     $names{ $_ } = $diagrams->{ $_ }->{ 'name' };
304 :     $counter++;
305 :     }
306 :    
307 : bartels 1.3 my $diagramchoose = "<H2>Choose other illustration</H2>\n";
308 : bartels 1.1 if ( scalar( @ids ) == 1 ) {
309 :     $diagramchoose .= "<P>There is one illustration for this subsystem.</P>";
310 :     }
311 :     else {
312 :     $diagramchoose .= "<P>There are ".scalar( @ids )." illustrations for this subsystem.</P>";
313 :     }
314 :     $diagramchoose .= $cgi->popup_menu( -name => 'diagram_selectbox',
315 :     -values => \@ids,
316 :     -default => $default_num,
317 :     -labels => \%names,
318 :     -maxlength => 150,
319 :     );
320 :    
321 : bartels 1.3 $diagramchoose .= $cgi->submit( -name => 'Show this illustration' );
322 : bartels 1.1
323 :     return $diagramchoose;
324 :     }
325 :    
326 :    
327 :     ###################################
328 :     # build the little upload diagram #
329 :     ###################################
330 :     sub build_upload_diagram {
331 :    
332 :     my ( $self, $fig, $subsystem_name ) = @_;
333 :    
334 : bartels 1.3 my $diagramupload = "<H2>Upload new illustration</H2>\n";
335 :     $diagramupload .= "<A HREF='".$self->application->url()."?page=UploadDiagram&subsystem=$subsystem_name&illustration=1' target='_blank'>Upload a new illustration or change an existing one for this subsystem</A>";
336 :    
337 :     return $diagramupload;
338 :    
339 :     }
340 :    
341 :     ###################################
342 :     # build the little delete diagram #
343 :     ###################################
344 :     sub build_delete_diagram {
345 :    
346 :     my ( $self, $fig, $subsystem, $diagramid ) = @_;
347 :    
348 :     my $diagramdelete = "<H2>Delete currently shown illustration</H2>\n";
349 :    
350 :     my $deletebutton = "<INPUT TYPE=HIDDEN NAME='DIAGRAMID' ID='DIAGRAMID' VALUE='$diagramid'><INPUT TYPE=HIDDEN NAME='DELETEBUTTONPRESSED' ID='DELETEBUTTONPRESSED' VALUE=0><INPUT TYPE=BUTTON VALUE='Delete Illustration' NAME='DELETEDIAGRAMBUTTON' ID='DELETEDIAGRAMBUTTON' ONCLICK='if ( confirm( \"Do you really want to illustration the diagram $diagramid?\" ) ) {
351 :     document.getElementById( \"DELETEBUTTONPRESSED\" ).value = 1;
352 :     document.getElementById( \"diagram_select_genome\" ).submit(); }'>";
353 :    
354 :     $diagramdelete .= $deletebutton;
355 : bartels 1.1
356 :     }
357 :    
358 :     sub calculate_scale {
359 :     my ( $width, $height ) = @_;
360 :    
361 :     my $scale = 1;
362 :     if ( $width > MAX_WIDTH ) {
363 :     $scale = MAX_WIDTH / $width;
364 :     }
365 :     if ( $height > MAX_HEIGHT and
366 :     (( MAX_HEIGHT / $height) < $scale) ) {
367 :     $scale = MAX_HEIGHT / $height;
368 :     }
369 :    
370 :     $scale = $scale < MIN_SCALE ? MIN_SCALE : $scale ;
371 :    
372 :     return ( $scale, $scale * $width, $scale * $height );
373 :     }
374 :    
375 : bartels 1.3 sub delete_illustration {
376 :    
377 :     my ( $subsystem, $id ) = @_;
378 :    
379 :     $subsystem->delete_diagram( $id );
380 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3