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

Annotation of /SubsystemEditor/WebPage/ShowIllustrations.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3