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

Annotation of /SubsystemEditor/WebPage/ShowSubsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.35 - (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 : bartels 1.12 $self->application->register_component( 'Table', 'VarDescTable' );
23 : bartels 1.2 }
24 :    
25 :     #################################
26 :     # File where Javascript resides #
27 :     #################################
28 :     sub require_javascript {
29 :    
30 :     return [ './Html/showfunctionalroles.js' ];
31 :    
32 : bartels 1.1 }
33 :    
34 :     ##############################################
35 :     # Website content is returned by this method #
36 :     ##############################################
37 :     sub output {
38 :     my ( $self ) = @_;
39 : bartels 1.2
40 : bartels 1.25 my $fig = $self->application->data_handle( 'FIG' );
41 : bartels 1.1 my $cgi = $self->application->cgi;
42 :    
43 : bartels 1.2 # subsystem name and 'nice name' #
44 : bartels 1.1 my $name = $cgi->param( 'subsystem' );
45 : bartels 1.27 $name = uri_unescape( $name );
46 :     $name =~ s/&#39/'/g;
47 : bartels 1.1 my $ssname = $name;
48 :     $ssname =~ s/\_/ /g;
49 :    
50 : bartels 1.2 # look if someone is logged in and can write the subsystem #
51 :     my $can_alter = 0;
52 :     my $user = $self->application->session->user;
53 : bartels 1.4
54 : paczian 1.22 my $dbmaster = $self->application->dbmaster;
55 :     my $ppoapplication = $self->application->backend;
56 : bartels 1.4
57 :     # get a seeduser #
58 :     my $seeduser = '';
59 :     if ( defined( $user ) && ref( $user ) ) {
60 :     my $preferences = $dbmaster->Preferences->get_objects( { user => $user,
61 :     name => 'SeedUser',
62 :     application => $ppoapplication } );
63 :     if ( defined( $preferences->[0] ) ) {
64 :     $seeduser = $preferences->[0]->value();
65 :     }
66 :     }
67 :    
68 : bartels 1.6 if ( $user ) {
69 :     if ( $user->has_right( $self->application, 'edit', 'subsystem', $name ) ) {
70 :     $can_alter = 1;
71 :     $fig->set_user( $seeduser );
72 :     }
73 :     else {
74 :     # we might have the problem that the user has not yet got the right for editing the
75 :     # subsystem due to that it was created in the old seed or what do I know where.
76 :     my $curatorOfSS = $fig->subsystem_curator( $name );
77 : bartels 1.7 my $su = lc( $seeduser );
78 :     my $cu = lc( $curatorOfSS );
79 :     if ( $su eq $cu ) {
80 : bartels 1.6 # now set the rights...
81 :     my $right = $dbmaster->Rights->create( { name => 'edit',
82 :     scope => $user->get_user_scope,
83 :     data_type => 'subsystem',
84 :     data_id => $name,
85 :     granted => 1,
86 :     delegated => 0 } );
87 :     if ( $right ) {
88 :     $can_alter = 1;
89 :     $fig->set_user( $seeduser );
90 :     }
91 :     }
92 :     }
93 : bartels 1.2 }
94 : bartels 1.6
95 : bartels 1.1 ######################
96 :     # Construct the menu #
97 :     ######################
98 :    
99 :     my $menu = $self->application->menu();
100 :    
101 : bartels 1.15 my $esc_name = uri_escape($name);
102 :    
103 : bartels 1.1 # Build nice tab menu here
104 : bartels 1.15 $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$esc_name" );
105 :     $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$esc_name" );
106 : bartels 1.21 $menu->add_category( 'Subsets', "SubsysEditor.cgi?page=ShowSubsets&subsystem=$esc_name" );
107 : redwards 1.35 $menu->add_category( 'Diagrams and Illustrations' );
108 :     $menu->add_entry( 'Diagrams and Illustrations', 'Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$esc_name" );
109 :     $menu->add_entry( 'Diagrams and Illustrations', 'Illustrations', "SubsysEditor.cgi?page=ShowIllustrations&subsystem=$esc_name" );
110 : bartels 1.15 $menu->add_category( 'Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$esc_name" );
111 :     $menu->add_category( 'Show Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$esc_name" );
112 :     $menu->add_category( 'Show Connections', "SubsysEditor.cgi?page=ShowTree&subsystem=$esc_name" );
113 : bartels 1.1
114 :    
115 :     ##############################
116 :     # Construct the page content #
117 :     ##############################
118 :    
119 : bartels 1.2 my $content = qq~
120 :     <STYLE>
121 :     .hideme {
122 :     display: none;
123 :     }
124 :     .showme {
125 :     display: all;
126 :     }
127 :     </STYLE>
128 :     ~;
129 :    
130 :     $content .= "<H2>Subsystem Info</H2>";
131 :     my $subsystem = new Subsystem( $name, $fig, 0 );
132 :    
133 :     if ( defined( $cgi->param( 'SUBMIT' ) ) ) {
134 :    
135 :     # set description and notes
136 :     my $descrp = $cgi->param( 'SSDESC' );
137 :     chomp $descrp;
138 :     $descrp .= "\n";
139 :     $subsystem->set_description( $descrp );
140 :     my $notes = $cgi->param( 'SSNOTES' );
141 :     chomp $notes;
142 :     $notes .= "\n";
143 :     $subsystem->set_notes( $notes );
144 :    
145 :     my $class1 = '';
146 :     my $class2 = '';
147 :    
148 :     if ( defined( $cgi->param( 'Classification' ) ) ) {
149 :     if ( $cgi->param( 'Classification' ) eq 'User-defined' ) {
150 :     if ( defined( $cgi->param( "SUBSYSH1TF" ) ) ) {
151 :     $class1 = $cgi->param( "SUBSYSH1TF" );
152 :     }
153 :     }
154 :     else {
155 :     if ( defined( $cgi->param( "SUBSYSH1" ) ) ) {
156 :     $class1 = $cgi->param( "SUBSYSH1" );
157 :     }
158 :     }
159 :     }
160 :    
161 :     if ( defined( $cgi->param( 'Classification' ) ) ) {
162 :     if ( $cgi->param( 'Classification' ) eq 'User-defined' ) {
163 :     if ( defined( $cgi->param( "SUBSYSH2TF" ) ) ) {
164 :     $class2 = $cgi->param( "SUBSYSH2TF" );
165 :     }
166 :     }
167 :     else {
168 :     if ( defined( $cgi->param( "SUBSYSH2" ) ) ) {
169 :     $class2 = $cgi->param( "SUBSYSH2" );
170 :     }
171 :     }
172 :     }
173 :     $subsystem->set_classification( [ $class1, $class2 ] );
174 :    
175 : bartels 1.10 my $litstoset = $cgi->param( 'SUBSYSLIT' );
176 : bartels 1.23 $litstoset =~ s/ //g;
177 :     my @lits = split( ',', $litstoset );
178 : bartels 1.10 setLiteratures( $fig, $name, \@lits );
179 :    
180 : bartels 1.13 my $wlstoset = $cgi->param( 'SUBSYSWL' );
181 :     if ( defined( $wlstoset ) && $wlstoset =~ /.+\s+.+/ ) {
182 :     my @wls = split( '\n', $wlstoset );
183 :     setWeblinks( $fig, $name, \@wls );
184 :     }
185 :    
186 : bartels 1.2 # here we really edit the files in the subsystem directory #
187 :     $subsystem->incr_version();
188 :     $subsystem->db_sync();
189 :     $subsystem->write_subsystem();
190 :     }
191 : bartels 1.25 elsif ( defined( $cgi->param( 'GrantRightButton' ) ) ) {
192 :     if ( $can_alter && $user->has_right( undef, 'edit', 'subsystem', $name, 1 ) ) {
193 : paczian 1.31 my ($newAnno, $readable_name) = split(/\|/, $cgi->param( 'ANNOBOX' ));
194 : paczian 1.29 my $thisScopes = $dbmaster->Scope->get_objects( { _id => $newAnno } );
195 :     if ( defined( $thisScopes->[0]) ) {
196 : bartels 1.27
197 : bartels 1.25 my $rights = $dbmaster->Rights->get_objects( { name => 'edit',
198 :     data_type => 'subsystem',
199 :     data_id => $name,
200 : paczian 1.29 scope => $thisScopes->[0] } );
201 : bartels 1.25 if ( defined( $rights->[0] ) ) {
202 : paczian 1.29 $self->application->add_message( 'warning', "$readable_name already has the right to edit this subsystem." );
203 : bartels 1.25 }
204 :     else {
205 :     my $right = $dbmaster->Rights->create( { granted => 1,
206 :     delegated => 1,
207 :     name => 'edit',
208 :     data_type => 'subsystem',
209 :     data_id => $name,
210 : paczian 1.29 scope => $thisScopes->[0] } );
211 : bartels 1.25 if ( $right ) {
212 : paczian 1.29 $self->application->add_message( 'info', "$readable_name can now edit this subsystem" );
213 : bartels 1.25 }
214 :     else {
215 : paczian 1.29 $self->application->add_message( 'warning', "Could not create right to edit the subsystem for $readable_name" );
216 : bartels 1.25 }
217 :     }
218 :     }
219 :     }
220 :     else {
221 :     $self->application->add_message( 'warning', "You do not have the right to share the subsystem." );
222 :     }
223 :     }
224 :     elsif ( defined( $cgi->param( 'RevokeRightButton' ) ) ) {
225 :     if ( $can_alter && $user->has_right( undef, 'edit', 'subsystem', $name, 1 ) ) {
226 : paczian 1.31 my ($newAnno, $readable_name) = split(/\|/, $cgi->param( 'ALANNOBOX' ));
227 : paczian 1.29 my $thisScopes = $dbmaster->Scope->get_objects( { _id => $newAnno } );
228 : bartels 1.25 my $rights = $dbmaster->Rights->get_objects( { name => 'edit',
229 :     data_type => 'subsystem',
230 :     data_id => $name,
231 : paczian 1.29 scope => $thisScopes->[0] } );
232 : bartels 1.25
233 :     my $thisRight = $rights->[0];
234 : paczian 1.33 if ( defined( $thisRight ) && $thisRight->delegated ) {
235 : bartels 1.25 $thisRight->delete();
236 :    
237 : paczian 1.29 $self->application->add_message( 'info', "$readable_name cannot edit this subsystem any more." );
238 : bartels 1.25 }
239 :     else {
240 : paczian 1.29 $self->application->add_message( 'warning', "You can't revoke the right of $readable_name to edit this subsystem." );
241 : bartels 1.25 }
242 :     }
243 :     else {
244 :     $self->application->add_message( 'warning', "You do not have the right to revoke rights for this subsystem." );
245 :     }
246 :     }
247 : bartels 1.1
248 : bartels 1.2 $subsystem = new Subsystem( $name, $fig, 0 );
249 :    
250 :     $content .= $self->start_form( 'form', { subsystem => $name } );
251 :    
252 : bartels 1.1 my ( $ssversion, $sscurator, $pedigree, $ssroles ) = $fig->subsystem_info( $name );
253 : bartels 1.3
254 :     my $versionlink = '';
255 : bartels 1.5
256 : bartels 1.3 if ( $can_alter ) {
257 : bartels 1.16 $versionlink = " -- <A HREF='".$self->application->url()."?page=ResetSubsystem&subsystem=$esc_name'>Reset to Previous Timestamp</A>";
258 : bartels 1.3 }
259 :    
260 : bartels 1.1 my $mod_time = get_mod_time( $name );
261 :     my $class = $fig->subsystem_classification( $name );
262 :     my $ssnotes = $subsystem->get_notes();
263 :    
264 : bartels 1.2 if ( !defined( $ssnotes ) ) {
265 :     $ssnotes = '';
266 :     }
267 :     my $ssdesc = $subsystem->get_description();
268 :    
269 :     if ( !defined( $ssdesc ) ) {
270 :     $ssdesc = '';
271 :     }
272 :    
273 :     my $classification_stuff;
274 :     if ( $can_alter ) {
275 :     $classification_stuff = get_classification_boxes( $fig, $cgi, $class->[0], $class->[1] );
276 :     }
277 :     else {
278 :     $classification_stuff = "<TR><TH>Classification:</TH><TD>$class->[0]</TD></TR>";
279 :     $classification_stuff .= "<TR><TH></TH><TD>$class->[1]</TD></TR>";
280 :     }
281 : bartels 1.1
282 : bartels 1.11 my $infotable = "<TABLE><TR><TH>Name:</TH><TD>$ssname</TD></TR>";
283 : bartels 1.1 $infotable .= "<TR><TH>Author:</TH><TD>$sscurator</TD></TR>";
284 : paczian 1.28 if ( $can_alter && $user->has_right( undef, 'edit', 'subsystem', $name, 1 ) && !$self->application->{anonymous_mode}) {
285 : bartels 1.25
286 :     my $annoGrp = $dbmaster->Scope->get_objects( { name => 'Annotators' } );
287 :     my $annoScope = $dbmaster->UserHasScope->get_objects( { scope => $annoGrp->[0] } );
288 :     my $annoMems = [];
289 :     foreach my $aS ( @$annoScope ) {
290 :     push @$annoMems, $aS->user();
291 :     }
292 :     @$annoMems = sort { $a->lastname cmp $b->lastname || $a->firstname cmp $b->firstname } @$annoMems;
293 :    
294 :     my $editRightButton = "<INPUT TYPE=SUBMIT ID='GrantRightButton' NAME='GrantRightButton' VALUE='Grant Right'>";
295 :     my $revokeRightButton = "<INPUT TYPE=SUBMIT ID='RevokeRightButton' NAME='RevokeRightButton' VALUE='Revoke Right'>";
296 :    
297 : paczian 1.29 my $user_has_scopes = $dbmaster->UserHasScope->get_objects( { user => $user });
298 : paczian 1.33 my $available_groups = {};
299 :     foreach my $user_has_scope (@$user_has_scopes) {
300 :     my $scope = $user_has_scope->scope();
301 :     next if $scope->name() =~ /^user:/;
302 :     next if $scope->name() =~/^Public/;
303 :     $available_groups->{$scope->{_id}} = $scope;
304 :     }
305 :     my $all_ss_edit_rights = $dbmaster->Rights->get_objects( { name => 'edit',
306 :     data_type => 'subsystem',
307 :     data_id => $name } );
308 : paczian 1.29 my $user_groups_have_right = [];
309 :     my $user_groups_not_have_right = [];
310 : paczian 1.33 foreach my $r (@$all_ss_edit_rights) {
311 :     my $scope = $r->scope;
312 : paczian 1.29 next if $scope->name() =~ /^user:/;
313 :     next if $scope->name() =~/^Public/;
314 : paczian 1.33 push(@$user_groups_have_right, [ $scope->_id, $scope->name ]);
315 :     delete $available_groups->{$scope->{_id}};
316 :     }
317 :     foreach my $key (sort(keys(%$available_groups))) {
318 :     my $scope = $available_groups->{$key};
319 :     push(@$user_groups_not_have_right, [ $scope->_id, $scope->name ]);
320 : paczian 1.29 }
321 :    
322 : bartels 1.25 my $annotatorsBox = "<SELECT NAME='ANNOBOX' ID='ANNOBOX'>";
323 :     my $alreadyAnnotatorsBox = "<SELECT NAME='ALANNOBOX' ID='ALANNOBOX'>";
324 : paczian 1.29 foreach my $a ( @$user_groups_have_right ) {
325 : paczian 1.30 $alreadyAnnotatorsBox .= "<OPTION VALUE='".$a->[0]."|group ".$a->[1]."'>group ".$a->[1]."</OPTION>";
326 : paczian 1.29 }
327 :     foreach my $a ( @$user_groups_not_have_right ) {
328 : paczian 1.30 $annotatorsBox .= "<OPTION VALUE='".$a->[0]."|group ".$a->[1]."'>group ".$a->[1]."</OPTION>";
329 : paczian 1.29 }
330 : bartels 1.25 foreach my $a ( @$annoMems ) {
331 : paczian 1.33 my $r = $dbmaster->Rights->get_objects( { name => 'edit',
332 :     scope => $a->get_user_scope,
333 :     data_type => 'subsystem',
334 :     data_id => $name } );
335 :     unless ( scalar(@$r) ) {
336 : paczian 1.29 $annotatorsBox .= "<OPTION VALUE='".$a->get_user_scope->_id."|".$a->firstname." ".$a->lastname."'>".$a->firstname.' '.$a->lastname.' ( '.$a->login." )</OPTION>";
337 : bartels 1.25 }
338 :     else {
339 :     if ( $a->login() ne $user->login() && ( ! $a->has_right( undef, 'edit', 'subsystem', '*' ) ) ) {
340 : paczian 1.29 $alreadyAnnotatorsBox .= "<OPTION VALUE='".$a->get_user_scope->_id."|".$a->firstname." ".$a->lastname."'>".$a->firstname.' '.$a->lastname.' ( '.$a->login." )</OPTION>";
341 : bartels 1.25 }
342 :     }
343 :     }
344 :     $annotatorsBox .= "</SELECT>";
345 :     $alreadyAnnotatorsBox .= "</SELECT>";
346 :    
347 :     $infotable .= "<TR><TH>Grant Right To Edit To:</TH><TD>$annotatorsBox $editRightButton</TD></TR>";
348 :     $infotable .= "<TR><TH>Revoke Right To Edit From:</TH><TD>$alreadyAnnotatorsBox $revokeRightButton</TD></TR>";
349 :     }
350 : bartels 1.3 $infotable .= "<TR><TH>Version:</TH><TD>$ssversion $versionlink</TD></TR>";
351 : bartels 1.1 $infotable .= "<TR><TH>Last Modified:</TH><TD>$mod_time</TD></TR>";
352 : bartels 1.10
353 : bartels 1.13 # Literature #
354 : bartels 1.10 my $lit = getLiteratures( $fig, $name );
355 :     my $litstring = '';
356 :     my $litvoid = '';
357 :     if ( defined( $lit ) && scalar( @$lit ) > 0 ) {
358 :     my @litlinks;
359 :     foreach my $l ( @$lit ) {
360 :     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>";
361 :     push @litlinks, $thislink;
362 :     }
363 :     $litstring = join( ', ', @litlinks );
364 :     $litvoid = join( ', ', @$lit );
365 :     }
366 :    
367 : bartels 1.13 # Weblinks #
368 :     my ( $wl, $wlvoid ) = getLinks( $fig, $name );
369 :    
370 : bartels 1.12 my $variants = $subsystem->get_variants();
371 :    
372 : bartels 1.2 if ( $can_alter ) {
373 : bartels 1.10
374 :     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\" );'>";
375 : bartels 1.13 my $editWLButton = "<INPUT TYPE=BUTTON ID='EditWLButton' VALUE='Edit Weblinks' ONCLICK='MakeEditableWL( \"0\" );'><INPUT TYPE=BUTTON ID='ShowWLButton' VALUE='Show Weblinks' STYLE='display: none;' ONCLICK='MakeEditableWL( \"1\" );'>";
376 :    
377 : redwards 1.34 $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;'>Please enter the PubMed ID (PMID), and we will automatically get the paper information. Multiple PMIDs should be separated by \', \'</SPAN></TD></TR></TABLE></TD></TR>";
378 :     $infotable .= "<TR><TH>Websites</TH><TD><TABLE><TR><TD><SPAN ID='WLSpan'>$wl</SPAN></TD><TD>$editWLButton</TD><TD><TEXTAREA ROWS=3 STYLE='width: 400px; display: none;' NAME='SUBSYSWL' ID='SUBSYSWL'>$wlvoid</TEXTAREA></TD><TD><SPAN ID='AREASPAN' STYLE='display: none;'>Please use the following format:<BR>Description of the first web page http://www.xyz.org/...<BR>Description of the second web page http://www.xzy.de/...</SPAN></TD></TR></TABLE></TD></TR>";
379 : bartels 1.19 $infotable .= "<TR><TH>Description</TH><TD><TEXTAREA NAME='SSDESC' ROWS=15 STYLE='width: 772px;'>$ssdesc</TEXTAREA></TD></TR>";
380 :     $infotable .= "<TR><TH>Notes</TH><TD><TEXTAREA NAME='SSNOTES' ROWS=15 STYLE='width: 772px;'>$ssnotes</TEXTAREA></TD></TR>";
381 : bartels 1.2 }
382 :     else {
383 :     # do a little formating because the notes often contain many many blanks and newlines
384 :     my $ssdesc_brs = $ssdesc;
385 :     $ssdesc_brs =~ s/\n/<BR>/g;
386 :     $ssdesc_brs =~ s/(\n\s)+/\n/g;
387 :     my $ssnotes_brs = $ssnotes;
388 :     $ssnotes_brs =~ s/(\n\s)+/\n/g;
389 :     $ssnotes_brs =~ s/\n/<BR>/g;
390 : bartels 1.11 $infotable .= "<TR><TH>Literature</TH><TD>$litstring</TD></TR>";
391 : bartels 1.14 $infotable .= "<TR><TH>Websites</TH><TD>$wl</TD></TR>";
392 : bartels 1.2 $infotable .= "<TR><TH>Description</TH><TD>$ssdesc_brs</TD></TR>";
393 :     $infotable .= "<TR><TH>Notes</TH><TD>$ssnotes_brs</TD></TR>";
394 :     }
395 : bartels 1.12 # variants
396 :     my $vartable = $self->application->component( 'VarDescTable' );
397 :     $vartable->columns( [ { name => "Variant" }, { name => "Description" } ] );
398 :    
399 :     my $vardata;
400 :     my $has_variants = 0;
401 :     foreach my $kv ( sort keys %$variants ) {
402 :     $has_variants = 1;
403 :     push @$vardata, [ $kv, $variants->{ $kv } ];
404 :     }
405 :     $vartable->data( $vardata );
406 :     $infotable .= "<TR><TH>Variants</TH><TD>";
407 :     if ( $has_variants ) {
408 :     $infotable .= $vartable->output();
409 :     }
410 :    
411 :     if ( $can_alter ) {
412 :     my $variant_outside = "<INPUT TYPE=BUTTON VALUE='Edit Variants in Variant Overview' NAME='EditVariantsOverview' ID='EditVariantsOverview' ONCLICK='window.open( \"".$self->application->url()."?page=ShowVariants&subsystem=$name\" )'>";
413 :     $infotable .= $variant_outside;
414 :     }
415 :    
416 :     $infotable .= "</TD</TR>";
417 :    
418 : bartels 1.2 $infotable .= $classification_stuff;
419 : bartels 1.1 $infotable .= "</TABLE>";
420 :    
421 : bartels 1.2 if ( $can_alter ) {
422 : bartels 1.20 $infotable .= "<INPUT TYPE=SUBMIT VALUE='Save Changes' ID='SUBMIT' NAME='SUBMIT' STYLE='background-color: red;'>";
423 : bartels 1.2 }
424 :    
425 : bartels 1.20 if ( $can_alter ) {
426 :     $content .= "<INPUT TYPE=SUBMIT VALUE='Save Changes' ID='SUBMIT' NAME='SUBMIT' STYLE='background-color: red;'>";
427 :     }
428 : bartels 1.1 $content .= $infotable;
429 : bartels 1.2 $content .= $self->end_form();
430 : bartels 1.1
431 :     return $content;
432 :     }
433 :    
434 :    
435 :     sub get_mod_time {
436 :    
437 :     my ( $ssa, $fig ) = @_;
438 :    
439 :     my( $t, @spreadsheets );
440 :     if ( opendir( BACKUP, "$FIG_Config::data/Subsystems/$ssa/Backup" ) ) {
441 :    
442 :     @spreadsheets = sort { $b <=> $a }
443 :     map { $_ =~ /^spreadsheet.(\d+)/; $1 }
444 :     grep { $_ =~ /^spreadsheet/ }
445 :     readdir(BACKUP);
446 :     closedir(BACKUP);
447 :    
448 :     if ( $t = shift @spreadsheets ) {
449 :     my $last_modified = &FIG::epoch_to_readable( $t );
450 :     return $last_modified;
451 :     }
452 :     }
453 : bartels 1.2 return "$FIG_Config::data/Subsystems/$ssa/Backup";
454 :     }
455 :    
456 :    
457 :     sub get_classification_boxes {
458 :     my ( $fig, $cgi, $class1, $class2 ) = @_;
459 :     my $classified = 1;
460 :    
461 :     my $sdContent = '';
462 :     my $SUBSYSH1 = $class1;
463 :     my $SUBSYSH2 = $class2;
464 :    
465 :     # variables that monitor if we have selected a box
466 :     my $putinh1 = 0;
467 :     my $putinh2 = 0;
468 :    
469 :     if ( !defined( $SUBSYSH1 ) ){
470 :     $putinh1 = 1;
471 :     }
472 :     if ( !defined( $SUBSYSH2 ) ){
473 :     $putinh2 = 1;
474 :     }
475 :    
476 :     my $inh1 = '';
477 :     if ( defined( $cgi->param( 'SUBSYSH1TF' ) ) ) {
478 :     $inh1 = $cgi->param( 'SUBSYSH1TF' );
479 :     }
480 :     elsif ( defined( $SUBSYSH1 ) ) {
481 :     if ( !$putinh1 ) {
482 :     $inh1 = $SUBSYSH1;
483 :     }
484 :     }
485 :     my $inh2 = '';
486 :     if ( defined( $cgi->param( 'SUBSYSH2TF' ) ) ) {
487 :     $inh2 = $cgi->param( 'SUBSYSH2TF' );
488 :     }
489 :     elsif ( defined( $SUBSYSH2 ) ) {
490 :     if ( !$putinh2 ) {
491 :     $inh2 = $SUBSYSH2;
492 :     }
493 :     }
494 :    
495 :     my @ssclassifications = $fig->all_subsystem_classifications();
496 :     my $ssclass;
497 :     foreach my $ssc ( @ssclassifications ) {
498 : bartels 1.24 if ( !defined( $ssc->[1] ) ) {
499 :     $ssc->[1] = '';
500 :     }
501 :     # next if ( ( !defined( $ssc->[0] ) ) || ( !defined( $ssc->[1] ) ) );
502 :     next if ( !defined( $ssc->[0] ) );
503 :     next if ( $ssc->[0] eq '' );
504 :     # next if ( ( $ssc->[0] eq '' ) || ( $ssc->[1] eq '' ) );
505 : bartels 1.2 next if ( ( $ssc->[0] =~ /^\s+$/ ) || ( $ssc->[1] =~ /^\s+$/ ) );
506 :     push @{ $ssclass->{ $ssc->[0] } }, $ssc->[1];
507 :     }
508 :    
509 :    
510 :     my @options;
511 :     foreach my $firstc ( keys %$ssclass ) {
512 :     my $opt = "<SELECT SIZE=5 ID='$firstc' NAME='SUBSYSH2' STYLE='width: 386px;' class='hideme'>";
513 :     my $optstring = '';
514 :     foreach my $secc ( sort @{ $ssclass->{ $firstc } } ) {
515 : bartels 1.8 if ( defined( $SUBSYSH2 ) && $SUBSYSH2 eq $secc && $SUBSYSH1 eq $firstc ) {
516 : bartels 1.2 $optstring .= "<OPTION SELECTED VALUE='$secc'>$secc</OPTION>";
517 :     # we have to show the selectbox if there is a selected value
518 :     $opt = "<SELECT SIZE=5 ID='$firstc' NAME='SUBSYSH2' STYLE='width: 386px;' class='showme'>";
519 :     $putinh2 = 1;
520 :     }
521 :     else {
522 :     $optstring .= "<OPTION VALUE='$secc'>$secc</OPTION>";
523 :     }
524 :     }
525 :     $opt .= $optstring;
526 :     $opt .= "</SELECT>";
527 :     push @options, $opt;
528 :     }
529 :    
530 :     if ( $classified ) {
531 :     $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();'>";
532 :     }
533 :     else {
534 :     $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>";
535 :     }
536 :     foreach my $firstc ( sort keys %$ssclass ) {
537 :     if ( defined( $SUBSYSH1 ) && $SUBSYSH1 eq $firstc ) {
538 :     $sdContent .= "\n<OPTION SELECTED VALUE='$firstc'>$firstc</OPTION>\n";
539 :     $putinh1 = 1;
540 :     }
541 :     else {
542 :     $sdContent .= "\n<OPTION VALUE='$firstc'>$firstc</OPTION>\n";
543 :     }
544 :     }
545 :     $sdContent .= "</SELECT>";
546 :    
547 :     foreach my $opt ( @options ) {
548 :     $sdContent .= $opt;
549 :     }
550 :    
551 :     $sdContent .= "</TD></TR>";
552 :     if ( $classified ) {
553 :     $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>";
554 :     }
555 :     else {
556 :     $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>";
557 :     }
558 :    
559 :    
560 :     return $sdContent;
561 :     }
562 :    
563 : bartels 1.10 ########################################
564 :     # get Literature-string for subsystems #
565 :     ########################################
566 :     sub getLiteratures {
567 :     my ( $fig, $name ) = @_;
568 :    
569 : bartels 1.15 my $esc_name = uri_escape($name);
570 :    
571 : bartels 1.10 my $frpubs;
572 : bartels 1.17 my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$name, "SUBSYSTEM_PUBMED_RELEVANT" );
573 : bartels 1.10
574 :     foreach my $k ( @rel_lit_num ) {
575 :     my ( $ss, $key, $value ) = @$k;
576 :     push @$frpubs, $value;
577 :     }
578 :    
579 :     return $frpubs;
580 :     }
581 :    
582 : bartels 1.13 ######################################
583 :     # get Weblinks-string for subsystems #
584 :     ######################################
585 :     sub getLinks {
586 :     my ( $fig, $name ) = @_;
587 :    
588 : bartels 1.15 my $esc_name = uri_escape($name);
589 :    
590 : bartels 1.13 my $links;
591 :     my $linksstring = '';
592 :     my $linksvoid = '';
593 : bartels 1.17 my @rel_link_num = $fig->get_attributes( 'Subsystem:'.$name, "SUBSYSTEM_WEBLINKS" );
594 : bartels 1.13
595 :     foreach my $k ( @rel_link_num ) {
596 :     my ( $ss, $key, @value ) = @$k;
597 :     $linksstring .= $value[0].": <a href=\"javascript:void(0)\"onclick=\"window.open('".$value[1]."','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes')\">". $value[1]."</a><BR>";
598 :     $linksvoid .= $value[0]." ".$value[1]."\n";
599 :     }
600 :    
601 :     return ( $linksstring, $linksvoid );
602 :     }
603 :    
604 : bartels 1.10 ########################################
605 :     # set Literature-string for subsystems #
606 :     ########################################
607 :     sub setLiteratures {
608 :     my ( $fig, $name, $newpubs ) = @_;
609 :    
610 : bartels 1.15 my $esc_name = uri_escape($name);
611 :    
612 : bartels 1.10 my @values;
613 : bartels 1.17 my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$name, "SUBSYSTEM_PUBMED_RELEVANT" );
614 : bartels 1.10
615 :     foreach my $k ( @rel_lit_num ) {
616 :     my ( $ss, $key, $value ) = @$k;
617 : bartels 1.20 $fig->delete_matching_attributes( "Subsystem:$name", "SUBSYSTEM_PUBMED_RELEVANT" );
618 : bartels 1.10 }
619 :    
620 :     foreach my $np ( @$newpubs ) {
621 : bartels 1.17 $fig->add_attribute( "Subsystem:$name", "SUBSYSTEM_PUBMED_RELEVANT", $np );
622 : bartels 1.10 }
623 :     }
624 :    
625 : bartels 1.13 ########################################
626 :     # set Literature-string for subsystems #
627 :     ########################################
628 :     sub setWeblinks {
629 :     my ( $fig, $name, $newpubs ) = @_;
630 :    
631 : bartels 1.15 my $esc_name = uri_escape($name);
632 :    
633 : bartels 1.13 my @values;
634 : bartels 1.17 my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$name, "SUBSYSTEM_WEBLINKS" );
635 : bartels 1.13
636 :     foreach my $k ( @rel_lit_num ) {
637 :     my ( $ss, $key, $value ) = @$k;
638 : bartels 1.20 $fig->delete_matching_attributes( "Subsystem:$name", "SUBSYSTEM_WEBLINKS" );
639 : bartels 1.13 }
640 :    
641 :     foreach my $np ( @$newpubs ) {
642 : redwards 1.34 #my @h = split( /\s+/, $np );
643 :     $np =~ s/\s*(http\S+)\s*//;
644 :     my $link=$1;
645 : redwards 1.35 if ($np =~ /^\s*$/) {$np = "webpage"}
646 : redwards 1.34 $fig->add_attribute( "Subsystem:$name", "SUBSYSTEM_WEBLINKS", $np, $link );
647 :     print STDERR "Adding attribute 'Subsystem:$name' 'SUBSYSTEM_WEBLINKS', '$np', '$link'\n";
648 : bartels 1.13 }
649 :     }
650 :    
651 : bartels 1.2 sub supported_rights {
652 :    
653 :     return [ [ 'edit', 'subsystem', '*' ] ];
654 :    
655 : bartels 1.1 }
656 : bartels 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3