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

Annotation of /SubsystemEditor/WebPage/ShowSubsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : bartels 1.1 package SubsystemEditor::WebPage::ShowSubsystem;
2 :    
3 :     use strict;
4 :     use warnings;
5 :     use URI::Escape;
6 :     use HTML;
7 :     use Data::Dumper;
8 :    
9 :     use FIG;
10 :    
11 :     use base qw( WebPage );
12 :    
13 :     1;
14 :    
15 : bartels 1.2 ##############################################################
16 :     # Method for registering components etc. for the application #
17 :     ##############################################################
18 : bartels 1.1 sub init {
19 :     my ( $self ) = @_;
20 :    
21 : bartels 1.2 $self->application->register_component( 'Table', 'sstable' );
22 :     }
23 :    
24 :     #################################
25 :     # File where Javascript resides #
26 :     #################################
27 :     sub require_javascript {
28 :    
29 :     return [ './Html/showfunctionalroles.js' ];
30 :    
31 : bartels 1.1 }
32 :    
33 :     ##############################################
34 :     # Website content is returned by this method #
35 :     ##############################################
36 :     sub output {
37 :     my ( $self ) = @_;
38 : bartels 1.2
39 : bartels 1.1 my $fig = new FIG;
40 :     my $cgi = $self->application->cgi;
41 :    
42 : bartels 1.2 # subsystem name and 'nice name' #
43 : bartels 1.1 my $name = $cgi->param( 'subsystem' );
44 :     my $ssname = $name;
45 :     $ssname =~ s/\_/ /g;
46 :    
47 : bartels 1.2 # look if someone is logged in and can write the subsystem #
48 :     my $can_alter = 0;
49 :     my $user = $self->application->session->user;
50 : bartels 1.4
51 :     my $dbmaster = DBMaster->new( -database => 'WebAppBackend' );
52 :     my $ppoapplication = $dbmaster->Backend->init( { name => 'SubsystemEditor' } );
53 :    
54 :     # get a seeduser #
55 :     my $seeduser = '';
56 :     if ( defined( $user ) && ref( $user ) ) {
57 :     my $preferences = $dbmaster->Preferences->get_objects( { user => $user,
58 :     name => 'SeedUser',
59 :     application => $ppoapplication } );
60 :     if ( defined( $preferences->[0] ) ) {
61 :     $seeduser = $preferences->[0]->value();
62 :     }
63 :     }
64 :    
65 : bartels 1.6 if ( $user ) {
66 :     if ( $user->has_right( $self->application, 'edit', 'subsystem', $name ) ) {
67 :     $can_alter = 1;
68 :     $fig->set_user( $seeduser );
69 :     }
70 :     else {
71 :     # we might have the problem that the user has not yet got the right for editing the
72 :     # subsystem due to that it was created in the old seed or what do I know where.
73 :     my $curatorOfSS = $fig->subsystem_curator( $name );
74 : bartels 1.7 my $su = lc( $seeduser );
75 :     my $cu = lc( $curatorOfSS );
76 :     if ( $su eq $cu ) {
77 : bartels 1.6 # now set the rights...
78 :     my $right = $dbmaster->Rights->create( { name => 'edit',
79 :     scope => $user->get_user_scope,
80 :     data_type => 'subsystem',
81 :     data_id => $name,
82 :     granted => 1,
83 :     delegated => 0 } );
84 :     if ( $right ) {
85 :     $can_alter = 1;
86 :     $fig->set_user( $seeduser );
87 :     }
88 :     }
89 :     }
90 : bartels 1.2 }
91 : bartels 1.6
92 : bartels 1.1 ######################
93 :     # Construct the menu #
94 :     ######################
95 :    
96 :     my $menu = $self->application->menu();
97 :    
98 :     # Build nice tab menu here
99 :     $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$name" );
100 :     $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$name" );
101 : bartels 1.9 $menu->add_category( 'Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$name" );
102 :     $menu->add_category( 'Illustrations', "SubsysEditor.cgi?page=ShowIllustrations&subsystem=$name" );
103 :     $menu->add_category( 'Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$name" );
104 :     $menu->add_category( 'Show Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$name" );
105 :     $menu->add_category( 'Show Tree', "SubsysEditor.cgi?page=ShowTree&subsystem=$name" );
106 : bartels 1.1
107 :    
108 :     ##############################
109 :     # Construct the page content #
110 :     ##############################
111 :    
112 : bartels 1.2 my $content = qq~
113 :     <STYLE>
114 :     .hideme {
115 :     display: none;
116 :     }
117 :     .showme {
118 :     display: all;
119 :     }
120 :     </STYLE>
121 :     ~;
122 :    
123 :     $content .= "<H2>Subsystem Info</H2>";
124 :     my $subsystem = new Subsystem( $name, $fig, 0 );
125 :    
126 :     if ( defined( $cgi->param( 'SUBMIT' ) ) ) {
127 :    
128 :     # set description and notes
129 :     my $descrp = $cgi->param( 'SSDESC' );
130 :     chomp $descrp;
131 :     $descrp .= "\n";
132 :     $subsystem->set_description( $descrp );
133 :     my $notes = $cgi->param( 'SSNOTES' );
134 :     chomp $notes;
135 :     $notes .= "\n";
136 :     $subsystem->set_notes( $notes );
137 :    
138 :     my $class1 = '';
139 :     my $class2 = '';
140 :    
141 :     if ( defined( $cgi->param( 'Classification' ) ) ) {
142 :     if ( $cgi->param( 'Classification' ) eq 'User-defined' ) {
143 :     if ( defined( $cgi->param( "SUBSYSH1TF" ) ) ) {
144 :     $class1 = $cgi->param( "SUBSYSH1TF" );
145 :     }
146 :     }
147 :     else {
148 :     if ( defined( $cgi->param( "SUBSYSH1" ) ) ) {
149 :     $class1 = $cgi->param( "SUBSYSH1" );
150 :     }
151 :     }
152 :     }
153 :    
154 :     if ( defined( $cgi->param( 'Classification' ) ) ) {
155 :     if ( $cgi->param( 'Classification' ) eq 'User-defined' ) {
156 :     if ( defined( $cgi->param( "SUBSYSH2TF" ) ) ) {
157 :     $class2 = $cgi->param( "SUBSYSH2TF" );
158 :     }
159 :     }
160 :     else {
161 :     if ( defined( $cgi->param( "SUBSYSH2" ) ) ) {
162 :     $class2 = $cgi->param( "SUBSYSH2" );
163 :     }
164 :     }
165 :     }
166 :     $subsystem->set_classification( [ $class1, $class2 ] );
167 :    
168 : bartels 1.10 my $litstoset = $cgi->param( 'SUBSYSLIT' );
169 :     my @lits = split( ', ', $litstoset );
170 :     setLiteratures( $fig, $name, \@lits );
171 :    
172 : bartels 1.2 # here we really edit the files in the subsystem directory #
173 :     $subsystem->incr_version();
174 :     $subsystem->db_sync();
175 :     $subsystem->write_subsystem();
176 :     }
177 : bartels 1.1
178 : bartels 1.2 $subsystem = new Subsystem( $name, $fig, 0 );
179 :    
180 :     $content .= $self->start_form( 'form', { subsystem => $name } );
181 :    
182 : bartels 1.1 my ( $ssversion, $sscurator, $pedigree, $ssroles ) = $fig->subsystem_info( $name );
183 : bartels 1.3
184 :     my $versionlink = '';
185 : bartels 1.5
186 : bartels 1.3 if ( $can_alter ) {
187 : bartels 1.4 $versionlink = " -- <A HREF='".$self->application->url()."?page=ResetSubsystem&subsystem=$name'>Reset to Previous Timestamp</A>";
188 : bartels 1.3 }
189 :    
190 : bartels 1.1 my $mod_time = get_mod_time( $name );
191 :     my $class = $fig->subsystem_classification( $name );
192 :     my $ssnotes = $subsystem->get_notes();
193 :    
194 : bartels 1.2 if ( !defined( $ssnotes ) ) {
195 :     $ssnotes = '';
196 :     }
197 :     my $ssdesc = $subsystem->get_description();
198 :    
199 :     if ( !defined( $ssdesc ) ) {
200 :     $ssdesc = '';
201 :     }
202 :    
203 :     my $classification_stuff;
204 :     if ( $can_alter ) {
205 :     $classification_stuff = get_classification_boxes( $fig, $cgi, $class->[0], $class->[1] );
206 :     }
207 :     else {
208 :     $classification_stuff = "<TR><TH>Classification:</TH><TD>$class->[0]</TD></TR>";
209 :     $classification_stuff .= "<TR><TH></TH><TD>$class->[1]</TD></TR>";
210 :     }
211 : bartels 1.1
212 :     my $infotable = "<TABLE><TR><TH>Name:</TH><TD>$ssname</TD><TR>";
213 :     $infotable .= "<TR><TH>Author:</TH><TD>$sscurator</TD></TR>";
214 : bartels 1.3 $infotable .= "<TR><TH>Version:</TH><TD>$ssversion $versionlink</TD></TR>";
215 : bartels 1.1 $infotable .= "<TR><TH>Last Modified:</TH><TD>$mod_time</TD></TR>";
216 : bartels 1.10
217 :     my $lit = getLiteratures( $fig, $name );
218 :     my $litstring = '';
219 :     my $litvoid = '';
220 :     if ( defined( $lit ) && scalar( @$lit ) > 0 ) {
221 :     my @litlinks;
222 :     foreach my $l ( @$lit ) {
223 :     my $thislink = "<a href=\"javascript:void(0)\"onclick=\"window.open('http://www.ncbi.nlm.nih.gov/sites/entrez?cmd=retrieve&db=pubmed&list_uids=" . $l ."')\">$l</a>";
224 :     push @litlinks, $thislink;
225 :     }
226 :     $litstring = join( ', ', @litlinks );
227 :     $litvoid = join( ', ', @$lit );
228 :     }
229 :    
230 : bartels 1.2 if ( $can_alter ) {
231 : bartels 1.10
232 :     my $editLitButton = "<INPUT TYPE=BUTTON ID='EditLitButton' VALUE='Edit Literature' ONCLICK='MakeEditableLit( \"0\" );'><INPUT TYPE=BUTTON ID='ShowLitButton' VALUE='Show Links' STYLE='display: none;' ONCLICK='MakeEditableLit( \"1\" );'>";
233 :     $infotable .= "<TR><TH>Literature</TH><TD><TABLE><TR><TD><SPAN ID='LitSpan'>$litstring</SPAN></TD><TD>$editLitButton</TD><TD><INPUT TYPE=TEXT STYLE='width: 200px; display: none;' NAME='SUBSYSLIT' ID='SUBSYSLIT' VALUE='$litvoid'></TD><TD><SPAN ID='TEXTSPAN' STYLE='display: none;'>Multiple PMIDs should be separated by \', \'</SPAN></TD></TR></TABLE></TD></TR>";
234 : bartels 1.2 $infotable .= "<TR><TH>Description</TH><TD><TEXTAREA NAME='SSDESC' ROWS=6 STYLE='width: 772px;'>$ssdesc</TEXTAREA></TD></TR>";
235 :     $infotable .= "<TR><TH>Notes</TH><TD><TEXTAREA NAME='SSNOTES' ROWS=6 STYLE='width: 772px;'>$ssnotes</TEXTAREA></TD></TR>";
236 :     }
237 :     else {
238 :     # do a little formating because the notes often contain many many blanks and newlines
239 :     my $ssdesc_brs = $ssdesc;
240 :     $ssdesc_brs =~ s/\n/<BR>/g;
241 :     $ssdesc_brs =~ s/(\n\s)+/\n/g;
242 :     my $ssnotes_brs = $ssnotes;
243 :     $ssnotes_brs =~ s/(\n\s)+/\n/g;
244 :     $ssnotes_brs =~ s/\n/<BR>/g;
245 :     $infotable .= "<TR><TH>Description</TH><TD>$ssdesc_brs</TD></TR>";
246 :     $infotable .= "<TR><TH>Notes</TH><TD>$ssnotes_brs</TD></TR>";
247 :     }
248 :     $infotable .= $classification_stuff;
249 : bartels 1.1 $infotable .= "</TABLE>";
250 :    
251 : bartels 1.2 if ( $can_alter ) {
252 :     $infotable .= "<INPUT TYPE=SUBMIT VALUE='Save Changes' ID='SUBMIT' NAME='SUBMIT'>";
253 :     }
254 :    
255 : bartels 1.1 $content .= $infotable;
256 : bartels 1.2 $content .= $self->end_form();
257 : bartels 1.1
258 :     return $content;
259 :     }
260 :    
261 :    
262 :     sub get_mod_time {
263 :    
264 :     my ( $ssa, $fig ) = @_;
265 :    
266 :     my( $t, @spreadsheets );
267 :     if ( opendir( BACKUP, "$FIG_Config::data/Subsystems/$ssa/Backup" ) ) {
268 :    
269 :     @spreadsheets = sort { $b <=> $a }
270 :     map { $_ =~ /^spreadsheet.(\d+)/; $1 }
271 :     grep { $_ =~ /^spreadsheet/ }
272 :     readdir(BACKUP);
273 :     closedir(BACKUP);
274 :    
275 :     if ( $t = shift @spreadsheets ) {
276 :     my $last_modified = &FIG::epoch_to_readable( $t );
277 :     return $last_modified;
278 :     }
279 :     }
280 : bartels 1.2 return "$FIG_Config::data/Subsystems/$ssa/Backup";
281 :     }
282 :    
283 :    
284 :     sub get_classification_boxes {
285 :     my ( $fig, $cgi, $class1, $class2 ) = @_;
286 :     my $classified = 1;
287 :    
288 :     my $sdContent = '';
289 :     my $SUBSYSH1 = $class1;
290 :     my $SUBSYSH2 = $class2;
291 :    
292 :     # variables that monitor if we have selected a box
293 :     my $putinh1 = 0;
294 :     my $putinh2 = 0;
295 :    
296 :     if ( !defined( $SUBSYSH1 ) ){
297 :     $putinh1 = 1;
298 :     }
299 :     if ( !defined( $SUBSYSH2 ) ){
300 :     $putinh2 = 1;
301 :     }
302 :    
303 :     my $inh1 = '';
304 :     if ( defined( $cgi->param( 'SUBSYSH1TF' ) ) ) {
305 :     $inh1 = $cgi->param( 'SUBSYSH1TF' );
306 :     }
307 :     elsif ( defined( $SUBSYSH1 ) ) {
308 :     if ( !$putinh1 ) {
309 :     $inh1 = $SUBSYSH1;
310 :     }
311 :     }
312 :     my $inh2 = '';
313 :     if ( defined( $cgi->param( 'SUBSYSH2TF' ) ) ) {
314 :     $inh2 = $cgi->param( 'SUBSYSH2TF' );
315 :     }
316 :     elsif ( defined( $SUBSYSH2 ) ) {
317 :     if ( !$putinh2 ) {
318 :     $inh2 = $SUBSYSH2;
319 :     }
320 :     }
321 :    
322 :     my @ssclassifications = $fig->all_subsystem_classifications();
323 :     my $ssclass;
324 :     foreach my $ssc ( @ssclassifications ) {
325 :     next if ( ( !defined( $ssc->[0] ) ) || ( !defined( $ssc->[1] ) ) );
326 :     next if ( ( $ssc->[0] eq '' ) || ( $ssc->[1] eq '' ) );
327 :     next if ( ( $ssc->[0] =~ /^\s+$/ ) || ( $ssc->[1] =~ /^\s+$/ ) );
328 :     push @{ $ssclass->{ $ssc->[0] } }, $ssc->[1];
329 :     }
330 :    
331 :    
332 :     my @options;
333 :     foreach my $firstc ( keys %$ssclass ) {
334 :     my $opt = "<SELECT SIZE=5 ID='$firstc' NAME='SUBSYSH2' STYLE='width: 386px;' class='hideme'>";
335 :     my $optstring = '';
336 :     foreach my $secc ( sort @{ $ssclass->{ $firstc } } ) {
337 : bartels 1.8 if ( defined( $SUBSYSH2 ) && $SUBSYSH2 eq $secc && $SUBSYSH1 eq $firstc ) {
338 : bartels 1.2 $optstring .= "<OPTION SELECTED VALUE='$secc'>$secc</OPTION>";
339 :     # we have to show the selectbox if there is a selected value
340 :     $opt = "<SELECT SIZE=5 ID='$firstc' NAME='SUBSYSH2' STYLE='width: 386px;' class='showme'>";
341 :     $putinh2 = 1;
342 :     }
343 :     else {
344 :     $optstring .= "<OPTION VALUE='$secc'>$secc</OPTION>";
345 :     }
346 :     }
347 :     $opt .= $optstring;
348 :     $opt .= "</SELECT>";
349 :     push @options, $opt;
350 :     }
351 :    
352 :     if ( $classified ) {
353 :     $sdContent .= "<TR><TH><INPUT TYPE=\"RADIO\" NAME=\"Classification\" VALUE=\"Classified\" CHECKED onchange='radioclassification();'>Classification:</TH><TD><SELECT SIZE=5 ID='SUBSYSH1' NAME='SUBSYSH1' STYLE='width: 386px;' onclick='gethiddenoption();'>";
354 :     }
355 :     else {
356 :     $sdContent .= "<TR><TD><INPUT TYPE=\"RADIO\" NAME=\"Classification\" VALUE=\"Classified\" onchange='radioclassification();'>Classification:</TD><TD><SELECT SIZE=5 ID='SUBSYSH1' NAME='SUBSYSH1' STYLE='width: 386px;' onclick='gethiddenoption();' DISABLED=DISABLED>";
357 :     }
358 :     foreach my $firstc ( sort keys %$ssclass ) {
359 :     if ( defined( $SUBSYSH1 ) && $SUBSYSH1 eq $firstc ) {
360 :     $sdContent .= "\n<OPTION SELECTED VALUE='$firstc'>$firstc</OPTION>\n";
361 :     $putinh1 = 1;
362 :     }
363 :     else {
364 :     $sdContent .= "\n<OPTION VALUE='$firstc'>$firstc</OPTION>\n";
365 :     }
366 :     }
367 :     $sdContent .= "</SELECT>";
368 :    
369 :     foreach my $opt ( @options ) {
370 :     $sdContent .= $opt;
371 :     }
372 :    
373 :     $sdContent .= "</TD></TR>";
374 :     if ( $classified ) {
375 :     $sdContent .= "<TR><TH><INPUT TYPE=\"RADIO\" NAME=\"Classification\" VALUE=\"User-defined\" onchange='radioclassification();'>User-defined:</TH><TD><INPUT TYPE=TEXT STYLE='width: 386px;' NAME='SUBSYSH1TF' ID='SUBSYSH1TF' VALUE='' DISABLED=\"DISABLED\"><INPUT TYPE=TEXT STYLE='width: 386px;' NAME='SUBSYSH2TF' ID='SUBSYSH2TF' VALUE='' DISABLED=DISABLED></TD></TR>";
376 :     }
377 :     else {
378 :     $sdContent .= "<TR><TH><INPUT TYPE=\"RADIO\" NAME=\"Classification\" VALUE=\"User-defined\" CHECKED onchange='radioclassification();'>User-defined:</TH><TD><INPUT TYPE=TEXT STYLE='width: 386px;' NAME='SUBSYSH1TF' ID='SUBSYSH1TF' VALUE='$inh1'><INPUT TYPE=TEXT STYLE='width: 386px;' NAME='SUBSYSH2TF' ID='SUBSYSH2TF' VALUE='$inh2'></TD></TR>";
379 :     }
380 :    
381 :    
382 :     return $sdContent;
383 :     }
384 :    
385 : bartels 1.10 ########################################
386 :     # get Literature-string for subsystems #
387 :     ########################################
388 :     sub getLiteratures {
389 :     my ( $fig, $name ) = @_;
390 :    
391 :     my $frpubs;
392 :     my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$name, "SUBSYSTEM_PUBMED_RELEVANT" );
393 :    
394 :     foreach my $k ( @rel_lit_num ) {
395 :     my ( $ss, $key, $value ) = @$k;
396 :     push @$frpubs, $value;
397 :     }
398 :    
399 :     return $frpubs;
400 :     }
401 :    
402 :     ########################################
403 :     # set Literature-string for subsystems #
404 :     ########################################
405 :     sub setLiteratures {
406 :     my ( $fig, $name, $newpubs ) = @_;
407 :    
408 :     my @values;
409 :     my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$name, "SUBSYSTEM_PUBMED_RELEVANT" );
410 :    
411 :     foreach my $k ( @rel_lit_num ) {
412 :     my ( $ss, $key, $value ) = @$k;
413 :     $fig->delete_matching_attributes( "Subsystem:$name", "SUBSYSTEM_PUBMED_RELEVANT", $value );
414 :     }
415 :    
416 :     foreach my $np ( @$newpubs ) {
417 :     $fig->add_attribute( "Subsystem:$name", "SUBSYSTEM_PUBMED_RELEVANT", $np );
418 :     }
419 :     }
420 :    
421 : bartels 1.2 sub supported_rights {
422 :    
423 :     return [ [ 'edit', 'subsystem', '*' ] ];
424 :    
425 : bartels 1.1 }
426 : bartels 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3