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

Annotation of /SubsystemEditor/WebPage/ShowIllustrations.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (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 : bartels 1.5 $menu->add_category( 'Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$esc_name" );
71 :     $menu->add_category( 'Illustrations', "SubsysEditor.cgi?page=ShowIllustrations&subsystem=$esc_name" );
72 :     $menu->add_category( 'Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$esc_name" );
73 :     $menu->add_category( 'Show Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$esc_name" );
74 :     $menu->add_category( 'Show Connections', "SubsysEditor.cgi?page=ShowTree&subsystem=$esc_name" );
75 : bartels 1.1
76 :     my $error = '';
77 :     my $comment = '';
78 :    
79 : bartels 1.3 #########
80 :     # TASKS #
81 :     #########
82 :    
83 :     if ( defined( $cgi->param( 'DELETEBUTTONPRESSED' ) ) && $cgi->param( 'DELETEBUTTONPRESSED' ) == 1 ) {
84 :     my $diagramid = $cgi->param( 'DIAGRAMID' );
85 :     &delete_illustration( $subsystem, $diagramid );
86 :     $cgi->delete( 'diagram' );
87 :     $cgi->delete( 'DIAGRAMID' );
88 :     $cgi->delete( 'diagram_selectbox' );
89 :     }
90 :    
91 : bartels 1.1 ##############################
92 :     # Construct the page content #
93 :     ##############################
94 :    
95 :     my $content = "<H1>Subsystem Illustrations: $ssname</H1>";
96 :     $content .= "<P>Illustrations are general diagrams related to the subsystem that cannot be colored.</P>";
97 :    
98 :     my $diagram = $self->get_Diagram( $fig, $cgi, $can_alter );
99 :    
100 :     $content .= $diagram;
101 :    
102 :    
103 :     ###############################
104 :     # Display errors and comments #
105 :     ###############################
106 :    
107 :     if ( defined( $error ) && $error ne '' ) {
108 :     $self->application->add_message( 'warning', $error );
109 :     }
110 :     if ( defined( $comment ) && $comment ne '' ) {
111 :     $self->application->add_message( 'info', $comment );
112 :     }
113 :    
114 :     return $content;
115 :     }
116 :    
117 :    
118 :     sub get_data {
119 :    
120 :     my ( $fig, $subsystem_name ) = @_;
121 :     my $subsystem = $fig->get_subsystem( $subsystem_name );
122 :    
123 :     my $default_diagram;
124 :     my $newDiagrams;
125 :    
126 :     foreach my $d ( $subsystem->get_diagrams ) {
127 :     my ( $id, $name ) = @$d;
128 :     unless ( $subsystem->is_new_diagram( $id ) ) {
129 :     $newDiagrams->{ $id }->{ 'name' } = $name;
130 :     if ( !defined( $default_diagram ) ) {
131 :     $default_diagram = $id;
132 :     }
133 :     }
134 :     }
135 :    
136 :     return ( $subsystem, $newDiagrams, $default_diagram );
137 :     }
138 :    
139 :     sub get_Diagram {
140 :     my ( $self, $fig, $cgi, $can_alter ) = @_;
141 :    
142 :     # get the subsystem
143 :     unless ( $cgi->param( 'subsystem' ) ) {
144 :     return '<p>CGI Parameter missing.</p>';
145 :     }
146 :     my $subsystem_name = $cgi->param( 'subsystem' ) || '';
147 :     my $subsystem_pretty = $subsystem_name;
148 :     $subsystem_pretty =~ s/_/ /g;
149 :     my ( $subsystem, $newDiagrams, $defaultDiagram ) = get_data( $fig, $subsystem_name );
150 :    
151 : bartels 1.5 my $esc_name = uri_escape($subsystem_name);
152 :    
153 : bartels 1.1 # check subsystem
154 :     unless ( $subsystem ) {
155 :     return "<p>Unable to find a subsystem called '$subsystem_name'.</p>";
156 :     }
157 :    
158 :     #####################################
159 :     # get values for attribute coloring #
160 :     #####################################
161 :    
162 :     my $color_by_attribute = 0;
163 :     my $attribute = $cgi->param( 'attribute_selectbox' );
164 :    
165 :    
166 :     # if diagram.cgi is called without the CGI param diagram (the diagram id)
167 :     # it will try to load the first 'new' diagram from the subsystem and
168 :     # print out an error message if there is no 'new' diagram
169 :     my $diagram_id = $cgi->param( 'diagram' ) || $cgi->param( 'diagram_selectbox' ) || '';
170 :    
171 : bartels 1.3 if ( defined( $cgi->param( 'Show this illustration' ) ) ) {
172 : bartels 1.1 $diagram_id = $cgi->param( 'diagram_selectbox' );
173 :     }
174 :    
175 :     unless ( $diagram_id ) {
176 :     $diagram_id = $defaultDiagram;
177 : bartels 1.3 $cgi->param( 'diagram_selectbox', $diagram_id );
178 : bartels 1.1 }
179 :    
180 :     # check diagram id
181 :     my $errortext = '';
182 :    
183 :     if ( !( $diagram_id ) ) {
184 :     $errortext .= "<p><em>Unable to find a diagram for this subsystem.</em><p>";
185 :     }
186 :    
187 :     # initialise a status string (log)
188 :     my $status = '';
189 :    
190 :     # generate the content
191 :     my $content = $errortext;
192 :    
193 :     # start form #
194 :     $content .= $self->start_form( 'diagram_select_genome' );
195 :     $content .= "<TABLE><TR><TD>";
196 :    
197 :     my $choose = build_show_other_diagram( $fig, $cgi, $subsystem, $newDiagrams, $diagram_id );
198 :    
199 :     my $scale = 1;
200 :    
201 :     $content .= "<DIV id='controlpanel'>$choose</DIV></TD><TR><TR><TD>";
202 :    
203 :     if ( $diagram_id ) {
204 : bartels 1.3
205 : bartels 1.1 # fetch the diagram
206 :     my $diagram_dir = $subsystem->{dir}."/diagrams/$diagram_id/";
207 :    
208 : bartels 1.3 if ( !( -d $diagram_dir ) ) {
209 :     $errortext .= "<P>The given diagram can not be found</P>";
210 :     }
211 :    
212 : bartels 1.1 my $d = $diagram_dir;
213 :     if ( -f $diagram_dir.'diagram.png' ) {
214 :     $d = $diagram_dir.'diagram.png';
215 :     }
216 :     elsif ( -f $diagram_dir.'diagram.jpg' ) {
217 :     $d = $diagram_dir.'diagram.jpg';
218 :     }
219 :     elsif ( -f $diagram_dir.'diagram.gif' ) {
220 :     $d = $diagram_dir.'diagram.gif';
221 :     }
222 :    
223 :     # print diagram
224 :     my $image = new WebGD( $d );
225 :     my ( $width, $height ) = ( $image->getBounds() );
226 :    
227 :     unless ( $cgi->param( 'dont_scale' ) ) {
228 :     ( $scale, $width, $height ) = calculate_scale( $width, $height );
229 :     }
230 :    
231 :     $content .= "<DIV><IMG SRC=\"".$image->image_src()."\" width=$width height=$height></DIV>";
232 :    
233 :     # add an info line about diagram scaling
234 :     my $scaling_info;
235 : bartels 1.3 if ( $scale == 1 ) {
236 : bartels 1.1 $scaling_info .= '<p><em>This diagram is not scaled.</em></p>';
237 :     }
238 :     else {
239 : bartels 1.3 $scaling_info .= '<p><em>This diagram has been scaled to '.$scale.'%. ';
240 : bartels 1.5 $scaling_info .= "(<a href='".$self->application->url()."?page=ShowIllustrations&subsystem=$esc_name&diagram=$diagram_id&dont_scale=1'>".
241 : bartels 1.1 "view in original size</a>)";
242 :     $scaling_info .= '</em></p>';
243 :     }
244 :     if ( $cgi->param( 'dont_scale' ) ) {
245 :     $scaling_info .= '<p><em>You have switched off scaling this diagram down. ';
246 : bartels 1.5 $scaling_info .= "(<a href='".$self->application->url()."?page=ShowIllustrations&subsystem=$esc_name&diagram=$diagram_id'>".
247 : bartels 1.1 "Allow scaling</a>)";
248 :     $scaling_info .= '</em></p>';
249 :     }
250 :    
251 :     $content .= "</TD></TR><TR><TD>$scaling_info</TD></TR>";
252 :     }
253 :    
254 :     $content .= "<TR><TD><DIV id='controlpanel'>$choose";
255 :    
256 :     # upload diagram only if can_alter #
257 :     if ( $can_alter ) {
258 : bartels 1.5 my $upload = $self->build_upload_diagram( $fig, $esc_name );
259 : bartels 1.1 $content .= "$upload";
260 : bartels 1.3
261 :     my $delete = '';
262 :     if ( defined( $diagram_id ) ) {
263 : bartels 1.5 $delete = $self->build_delete_diagram( $fig, $esc_name, $diagram_id );
264 : bartels 1.3 $content .= "$delete";
265 :     }
266 : bartels 1.1 }
267 :    
268 :     $content .= "</DIV></TD><TR></TABLE>";
269 :    
270 :     # hiddens for subsystem, diagram, scale #
271 :     $content .= $cgi->hidden( -name => 'subsystem',
272 : bartels 1.5 -value => $esc_name );
273 : bartels 1.1 $content .= $cgi->hidden( -name => 'diagram',
274 :     -value => $diagram_id );
275 :    
276 :     $content .= $cgi->hidden( -name => 'dont_scale', -value => 1 )
277 :     if ( $cgi->param( 'dont_scale' ) );
278 :    
279 :     $content .= $self->end_form();
280 :    
281 :     return $content;
282 :     }
283 :    
284 :     #######################################
285 :     # build the little show other diagram #
286 :     #######################################
287 :     sub build_show_other_diagram {
288 :    
289 :     my ( $fig, $cgi, $subsystem, $diagrams, $default ) = @_;
290 :    
291 :     my $default_num;
292 :    
293 :     my @ids = sort keys %$diagrams;
294 :     my %names;
295 :     my $counter = 0;
296 :     foreach ( @ids ) {
297 :     if ( $_ eq $default ) {
298 :     $default_num = $counter;
299 :     }
300 :     $names{ $_ } = $diagrams->{ $_ }->{ 'name' };
301 :     $counter++;
302 :     }
303 :    
304 : bartels 1.3 my $diagramchoose = "<H2>Choose other illustration</H2>\n";
305 : bartels 1.1 if ( scalar( @ids ) == 1 ) {
306 :     $diagramchoose .= "<P>There is one illustration for this subsystem.</P>";
307 :     }
308 :     else {
309 :     $diagramchoose .= "<P>There are ".scalar( @ids )." illustrations for this subsystem.</P>";
310 :     }
311 :     $diagramchoose .= $cgi->popup_menu( -name => 'diagram_selectbox',
312 :     -values => \@ids,
313 :     -default => $default_num,
314 :     -labels => \%names,
315 :     -maxlength => 150,
316 :     );
317 :    
318 : bartels 1.3 $diagramchoose .= $cgi->submit( -name => 'Show this illustration' );
319 : bartels 1.1
320 :     return $diagramchoose;
321 :     }
322 :    
323 :    
324 :     ###################################
325 :     # build the little upload diagram #
326 :     ###################################
327 :     sub build_upload_diagram {
328 :    
329 :     my ( $self, $fig, $subsystem_name ) = @_;
330 :    
331 : bartels 1.3 my $diagramupload = "<H2>Upload new illustration</H2>\n";
332 :     $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>";
333 :    
334 :     return $diagramupload;
335 :    
336 :     }
337 :    
338 :     ###################################
339 :     # build the little delete diagram #
340 :     ###################################
341 :     sub build_delete_diagram {
342 :    
343 :     my ( $self, $fig, $subsystem, $diagramid ) = @_;
344 :    
345 :     my $diagramdelete = "<H2>Delete currently shown illustration</H2>\n";
346 :    
347 :     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?\" ) ) {
348 :     document.getElementById( \"DELETEBUTTONPRESSED\" ).value = 1;
349 :     document.getElementById( \"diagram_select_genome\" ).submit(); }'>";
350 :    
351 :     $diagramdelete .= $deletebutton;
352 : bartels 1.1
353 :     }
354 :    
355 :     sub calculate_scale {
356 :     my ( $width, $height ) = @_;
357 :    
358 :     my $scale = 1;
359 :     if ( $width > MAX_WIDTH ) {
360 :     $scale = MAX_WIDTH / $width;
361 :     }
362 :     if ( $height > MAX_HEIGHT and
363 :     (( MAX_HEIGHT / $height) < $scale) ) {
364 :     $scale = MAX_HEIGHT / $height;
365 :     }
366 :    
367 :     $scale = $scale < MIN_SCALE ? MIN_SCALE : $scale ;
368 :    
369 :     return ( $scale, $scale * $width, $scale * $height );
370 :     }
371 :    
372 : bartels 1.3 sub delete_illustration {
373 :    
374 :     my ( $subsystem, $id ) = @_;
375 :    
376 :     $subsystem->delete_diagram( $id );
377 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3