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

Annotation of /SubsystemEditor/WebPage/ShowSubsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.16 - (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.1 my $fig = new FIG;
41 :     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 :     my $ssname = $name;
46 :     $ssname =~ s/\_/ /g;
47 :    
48 : bartels 1.2 # look if someone is logged in and can write the subsystem #
49 :     my $can_alter = 0;
50 :     my $user = $self->application->session->user;
51 : bartels 1.4
52 :     my $dbmaster = DBMaster->new( -database => 'WebAppBackend' );
53 :     my $ppoapplication = $dbmaster->Backend->init( { name => 'SubsystemEditor' } );
54 :    
55 :     # get a seeduser #
56 :     my $seeduser = '';
57 :     if ( defined( $user ) && ref( $user ) ) {
58 :     my $preferences = $dbmaster->Preferences->get_objects( { user => $user,
59 :     name => 'SeedUser',
60 :     application => $ppoapplication } );
61 :     if ( defined( $preferences->[0] ) ) {
62 :     $seeduser = $preferences->[0]->value();
63 :     }
64 :     }
65 :    
66 : bartels 1.6 if ( $user ) {
67 :     if ( $user->has_right( $self->application, 'edit', 'subsystem', $name ) ) {
68 :     $can_alter = 1;
69 :     $fig->set_user( $seeduser );
70 :     }
71 :     else {
72 :     # we might have the problem that the user has not yet got the right for editing the
73 :     # subsystem due to that it was created in the old seed or what do I know where.
74 :     my $curatorOfSS = $fig->subsystem_curator( $name );
75 : bartels 1.7 my $su = lc( $seeduser );
76 :     my $cu = lc( $curatorOfSS );
77 :     if ( $su eq $cu ) {
78 : bartels 1.6 # now set the rights...
79 :     my $right = $dbmaster->Rights->create( { name => 'edit',
80 :     scope => $user->get_user_scope,
81 :     data_type => 'subsystem',
82 :     data_id => $name,
83 :     granted => 1,
84 :     delegated => 0 } );
85 :     if ( $right ) {
86 :     $can_alter = 1;
87 :     $fig->set_user( $seeduser );
88 :     }
89 :     }
90 :     }
91 : bartels 1.2 }
92 : bartels 1.6
93 : bartels 1.1 ######################
94 :     # Construct the menu #
95 :     ######################
96 :    
97 :     my $menu = $self->application->menu();
98 :    
99 : bartels 1.15 my $esc_name = uri_escape($name);
100 :    
101 : bartels 1.1 # Build nice tab menu here
102 : bartels 1.15 $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$esc_name" );
103 :     $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$esc_name" );
104 :     $menu->add_category( 'Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$esc_name" );
105 :     $menu->add_category( 'Illustrations', "SubsysEditor.cgi?page=ShowIllustrations&subsystem=$esc_name" );
106 :     $menu->add_category( 'Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$esc_name" );
107 :     $menu->add_category( 'Show Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$esc_name" );
108 :     $menu->add_category( 'Show Connections', "SubsysEditor.cgi?page=ShowTree&subsystem=$esc_name" );
109 : bartels 1.1
110 :    
111 :     ##############################
112 :     # Construct the page content #
113 :     ##############################
114 :    
115 : bartels 1.2 my $content = qq~
116 :     <STYLE>
117 :     .hideme {
118 :     display: none;
119 :     }
120 :     .showme {
121 :     display: all;
122 :     }
123 :     </STYLE>
124 :     ~;
125 :    
126 :     $content .= "<H2>Subsystem Info</H2>";
127 :     my $subsystem = new Subsystem( $name, $fig, 0 );
128 :    
129 :     if ( defined( $cgi->param( 'SUBMIT' ) ) ) {
130 :    
131 :     # set description and notes
132 :     my $descrp = $cgi->param( 'SSDESC' );
133 :     chomp $descrp;
134 :     $descrp .= "\n";
135 :     $subsystem->set_description( $descrp );
136 :     my $notes = $cgi->param( 'SSNOTES' );
137 :     chomp $notes;
138 :     $notes .= "\n";
139 :     $subsystem->set_notes( $notes );
140 :    
141 :     my $class1 = '';
142 :     my $class2 = '';
143 :    
144 :     if ( defined( $cgi->param( 'Classification' ) ) ) {
145 :     if ( $cgi->param( 'Classification' ) eq 'User-defined' ) {
146 :     if ( defined( $cgi->param( "SUBSYSH1TF" ) ) ) {
147 :     $class1 = $cgi->param( "SUBSYSH1TF" );
148 :     }
149 :     }
150 :     else {
151 :     if ( defined( $cgi->param( "SUBSYSH1" ) ) ) {
152 :     $class1 = $cgi->param( "SUBSYSH1" );
153 :     }
154 :     }
155 :     }
156 :    
157 :     if ( defined( $cgi->param( 'Classification' ) ) ) {
158 :     if ( $cgi->param( 'Classification' ) eq 'User-defined' ) {
159 :     if ( defined( $cgi->param( "SUBSYSH2TF" ) ) ) {
160 :     $class2 = $cgi->param( "SUBSYSH2TF" );
161 :     }
162 :     }
163 :     else {
164 :     if ( defined( $cgi->param( "SUBSYSH2" ) ) ) {
165 :     $class2 = $cgi->param( "SUBSYSH2" );
166 :     }
167 :     }
168 :     }
169 :     $subsystem->set_classification( [ $class1, $class2 ] );
170 :    
171 : bartels 1.10 my $litstoset = $cgi->param( 'SUBSYSLIT' );
172 :     my @lits = split( ', ', $litstoset );
173 :     setLiteratures( $fig, $name, \@lits );
174 :    
175 : bartels 1.13 my $wlstoset = $cgi->param( 'SUBSYSWL' );
176 :     if ( defined( $wlstoset ) && $wlstoset =~ /.+\s+.+/ ) {
177 :     my @wls = split( '\n', $wlstoset );
178 :     setWeblinks( $fig, $name, \@wls );
179 :     }
180 :    
181 : bartels 1.2 # here we really edit the files in the subsystem directory #
182 :     $subsystem->incr_version();
183 :     $subsystem->db_sync();
184 :     $subsystem->write_subsystem();
185 :     }
186 : bartels 1.1
187 : bartels 1.15 print STDERR $name."\n";
188 :    
189 : bartels 1.2 $subsystem = new Subsystem( $name, $fig, 0 );
190 :    
191 :     $content .= $self->start_form( 'form', { subsystem => $name } );
192 :    
193 : bartels 1.1 my ( $ssversion, $sscurator, $pedigree, $ssroles ) = $fig->subsystem_info( $name );
194 : bartels 1.3
195 :     my $versionlink = '';
196 : bartels 1.5
197 : bartels 1.3 if ( $can_alter ) {
198 : bartels 1.16 $versionlink = " -- <A HREF='".$self->application->url()."?page=ResetSubsystem&subsystem=$esc_name'>Reset to Previous Timestamp</A>";
199 : bartels 1.3 }
200 :    
201 : bartels 1.1 my $mod_time = get_mod_time( $name );
202 :     my $class = $fig->subsystem_classification( $name );
203 :     my $ssnotes = $subsystem->get_notes();
204 :    
205 : bartels 1.2 if ( !defined( $ssnotes ) ) {
206 :     $ssnotes = '';
207 :     }
208 :     my $ssdesc = $subsystem->get_description();
209 :    
210 :     if ( !defined( $ssdesc ) ) {
211 :     $ssdesc = '';
212 :     }
213 :    
214 :     my $classification_stuff;
215 :     if ( $can_alter ) {
216 :     $classification_stuff = get_classification_boxes( $fig, $cgi, $class->[0], $class->[1] );
217 :     }
218 :     else {
219 :     $classification_stuff = "<TR><TH>Classification:</TH><TD>$class->[0]</TD></TR>";
220 :     $classification_stuff .= "<TR><TH></TH><TD>$class->[1]</TD></TR>";
221 :     }
222 : bartels 1.1
223 : bartels 1.11 my $infotable = "<TABLE><TR><TH>Name:</TH><TD>$ssname</TD></TR>";
224 : bartels 1.1 $infotable .= "<TR><TH>Author:</TH><TD>$sscurator</TD></TR>";
225 : bartels 1.3 $infotable .= "<TR><TH>Version:</TH><TD>$ssversion $versionlink</TD></TR>";
226 : bartels 1.1 $infotable .= "<TR><TH>Last Modified:</TH><TD>$mod_time</TD></TR>";
227 : bartels 1.10
228 : bartels 1.13 # Literature #
229 : bartels 1.10 my $lit = getLiteratures( $fig, $name );
230 :     my $litstring = '';
231 :     my $litvoid = '';
232 :     if ( defined( $lit ) && scalar( @$lit ) > 0 ) {
233 :     my @litlinks;
234 :     foreach my $l ( @$lit ) {
235 :     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>";
236 :     push @litlinks, $thislink;
237 :     }
238 :     $litstring = join( ', ', @litlinks );
239 :     $litvoid = join( ', ', @$lit );
240 :     }
241 :    
242 : bartels 1.13 # Weblinks #
243 :     my ( $wl, $wlvoid ) = getLinks( $fig, $name );
244 :    
245 : bartels 1.12 my $variants = $subsystem->get_variants();
246 :    
247 : bartels 1.2 if ( $can_alter ) {
248 : bartels 1.10
249 :     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\" );'>";
250 : 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\" );'>";
251 :    
252 : bartels 1.10 $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>";
253 : bartels 1.13 $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>Description1 http://www.xyz.org/...<BR>Description2 http://www.xzy.de/...</SPAN></TD></TR></TABLE></TD></TR>";
254 : bartels 1.2 $infotable .= "<TR><TH>Description</TH><TD><TEXTAREA NAME='SSDESC' ROWS=6 STYLE='width: 772px;'>$ssdesc</TEXTAREA></TD></TR>";
255 :     $infotable .= "<TR><TH>Notes</TH><TD><TEXTAREA NAME='SSNOTES' ROWS=6 STYLE='width: 772px;'>$ssnotes</TEXTAREA></TD></TR>";
256 :     }
257 :     else {
258 :     # do a little formating because the notes often contain many many blanks and newlines
259 :     my $ssdesc_brs = $ssdesc;
260 :     $ssdesc_brs =~ s/\n/<BR>/g;
261 :     $ssdesc_brs =~ s/(\n\s)+/\n/g;
262 :     my $ssnotes_brs = $ssnotes;
263 :     $ssnotes_brs =~ s/(\n\s)+/\n/g;
264 :     $ssnotes_brs =~ s/\n/<BR>/g;
265 : bartels 1.11 $infotable .= "<TR><TH>Literature</TH><TD>$litstring</TD></TR>";
266 : bartels 1.14 $infotable .= "<TR><TH>Websites</TH><TD>$wl</TD></TR>";
267 : bartels 1.2 $infotable .= "<TR><TH>Description</TH><TD>$ssdesc_brs</TD></TR>";
268 :     $infotable .= "<TR><TH>Notes</TH><TD>$ssnotes_brs</TD></TR>";
269 :     }
270 : bartels 1.12 # variants
271 :     my $vartable = $self->application->component( 'VarDescTable' );
272 :     $vartable->columns( [ { name => "Variant" }, { name => "Description" } ] );
273 :    
274 :     my $vardata;
275 :     my $has_variants = 0;
276 :     foreach my $kv ( sort keys %$variants ) {
277 :     $has_variants = 1;
278 :     push @$vardata, [ $kv, $variants->{ $kv } ];
279 :     }
280 :     $vartable->data( $vardata );
281 :     $infotable .= "<TR><TH>Variants</TH><TD>";
282 :     if ( $has_variants ) {
283 :     $infotable .= $vartable->output();
284 :     }
285 :    
286 :     if ( $can_alter ) {
287 :     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\" )'>";
288 :     $infotable .= $variant_outside;
289 :     }
290 :    
291 :     $infotable .= "</TD</TR>";
292 :    
293 : bartels 1.2 $infotable .= $classification_stuff;
294 : bartels 1.1 $infotable .= "</TABLE>";
295 :    
296 : bartels 1.2 if ( $can_alter ) {
297 :     $infotable .= "<INPUT TYPE=SUBMIT VALUE='Save Changes' ID='SUBMIT' NAME='SUBMIT'>";
298 :     }
299 :    
300 : bartels 1.1 $content .= $infotable;
301 : bartels 1.2 $content .= $self->end_form();
302 : bartels 1.1
303 :     return $content;
304 :     }
305 :    
306 :    
307 :     sub get_mod_time {
308 :    
309 :     my ( $ssa, $fig ) = @_;
310 :    
311 :     my( $t, @spreadsheets );
312 :     if ( opendir( BACKUP, "$FIG_Config::data/Subsystems/$ssa/Backup" ) ) {
313 :    
314 :     @spreadsheets = sort { $b <=> $a }
315 :     map { $_ =~ /^spreadsheet.(\d+)/; $1 }
316 :     grep { $_ =~ /^spreadsheet/ }
317 :     readdir(BACKUP);
318 :     closedir(BACKUP);
319 :    
320 :     if ( $t = shift @spreadsheets ) {
321 :     my $last_modified = &FIG::epoch_to_readable( $t );
322 :     return $last_modified;
323 :     }
324 :     }
325 : bartels 1.2 return "$FIG_Config::data/Subsystems/$ssa/Backup";
326 :     }
327 :    
328 :    
329 :     sub get_classification_boxes {
330 :     my ( $fig, $cgi, $class1, $class2 ) = @_;
331 :     my $classified = 1;
332 :    
333 :     my $sdContent = '';
334 :     my $SUBSYSH1 = $class1;
335 :     my $SUBSYSH2 = $class2;
336 :    
337 :     # variables that monitor if we have selected a box
338 :     my $putinh1 = 0;
339 :     my $putinh2 = 0;
340 :    
341 :     if ( !defined( $SUBSYSH1 ) ){
342 :     $putinh1 = 1;
343 :     }
344 :     if ( !defined( $SUBSYSH2 ) ){
345 :     $putinh2 = 1;
346 :     }
347 :    
348 :     my $inh1 = '';
349 :     if ( defined( $cgi->param( 'SUBSYSH1TF' ) ) ) {
350 :     $inh1 = $cgi->param( 'SUBSYSH1TF' );
351 :     }
352 :     elsif ( defined( $SUBSYSH1 ) ) {
353 :     if ( !$putinh1 ) {
354 :     $inh1 = $SUBSYSH1;
355 :     }
356 :     }
357 :     my $inh2 = '';
358 :     if ( defined( $cgi->param( 'SUBSYSH2TF' ) ) ) {
359 :     $inh2 = $cgi->param( 'SUBSYSH2TF' );
360 :     }
361 :     elsif ( defined( $SUBSYSH2 ) ) {
362 :     if ( !$putinh2 ) {
363 :     $inh2 = $SUBSYSH2;
364 :     }
365 :     }
366 :    
367 :     my @ssclassifications = $fig->all_subsystem_classifications();
368 :     my $ssclass;
369 :     foreach my $ssc ( @ssclassifications ) {
370 :     next if ( ( !defined( $ssc->[0] ) ) || ( !defined( $ssc->[1] ) ) );
371 :     next if ( ( $ssc->[0] eq '' ) || ( $ssc->[1] eq '' ) );
372 :     next if ( ( $ssc->[0] =~ /^\s+$/ ) || ( $ssc->[1] =~ /^\s+$/ ) );
373 :     push @{ $ssclass->{ $ssc->[0] } }, $ssc->[1];
374 :     }
375 :    
376 :    
377 :     my @options;
378 :     foreach my $firstc ( keys %$ssclass ) {
379 :     my $opt = "<SELECT SIZE=5 ID='$firstc' NAME='SUBSYSH2' STYLE='width: 386px;' class='hideme'>";
380 :     my $optstring = '';
381 :     foreach my $secc ( sort @{ $ssclass->{ $firstc } } ) {
382 : bartels 1.8 if ( defined( $SUBSYSH2 ) && $SUBSYSH2 eq $secc && $SUBSYSH1 eq $firstc ) {
383 : bartels 1.2 $optstring .= "<OPTION SELECTED VALUE='$secc'>$secc</OPTION>";
384 :     # we have to show the selectbox if there is a selected value
385 :     $opt = "<SELECT SIZE=5 ID='$firstc' NAME='SUBSYSH2' STYLE='width: 386px;' class='showme'>";
386 :     $putinh2 = 1;
387 :     }
388 :     else {
389 :     $optstring .= "<OPTION VALUE='$secc'>$secc</OPTION>";
390 :     }
391 :     }
392 :     $opt .= $optstring;
393 :     $opt .= "</SELECT>";
394 :     push @options, $opt;
395 :     }
396 :    
397 :     if ( $classified ) {
398 :     $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();'>";
399 :     }
400 :     else {
401 :     $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>";
402 :     }
403 :     foreach my $firstc ( sort keys %$ssclass ) {
404 :     if ( defined( $SUBSYSH1 ) && $SUBSYSH1 eq $firstc ) {
405 :     $sdContent .= "\n<OPTION SELECTED VALUE='$firstc'>$firstc</OPTION>\n";
406 :     $putinh1 = 1;
407 :     }
408 :     else {
409 :     $sdContent .= "\n<OPTION VALUE='$firstc'>$firstc</OPTION>\n";
410 :     }
411 :     }
412 :     $sdContent .= "</SELECT>";
413 :    
414 :     foreach my $opt ( @options ) {
415 :     $sdContent .= $opt;
416 :     }
417 :    
418 :     $sdContent .= "</TD></TR>";
419 :     if ( $classified ) {
420 :     $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>";
421 :     }
422 :     else {
423 :     $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>";
424 :     }
425 :    
426 :    
427 :     return $sdContent;
428 :     }
429 :    
430 : bartels 1.10 ########################################
431 :     # get Literature-string for subsystems #
432 :     ########################################
433 :     sub getLiteratures {
434 :     my ( $fig, $name ) = @_;
435 :    
436 : bartels 1.15 my $esc_name = uri_escape($name);
437 :    
438 : bartels 1.10 my $frpubs;
439 : bartels 1.15 my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$esc_name, "SUBSYSTEM_PUBMED_RELEVANT" );
440 : bartels 1.10
441 :     foreach my $k ( @rel_lit_num ) {
442 :     my ( $ss, $key, $value ) = @$k;
443 :     push @$frpubs, $value;
444 :     }
445 :    
446 :     return $frpubs;
447 :     }
448 :    
449 : bartels 1.13 ######################################
450 :     # get Weblinks-string for subsystems #
451 :     ######################################
452 :     sub getLinks {
453 :     my ( $fig, $name ) = @_;
454 :    
455 : bartels 1.15 my $esc_name = uri_escape($name);
456 :    
457 : bartels 1.13 my $links;
458 :     my $linksstring = '';
459 :     my $linksvoid = '';
460 : bartels 1.15 my @rel_link_num = $fig->get_attributes( 'Subsystem:'.$esc_name, "SUBSYSTEM_WEBLINKS" );
461 : bartels 1.13
462 :     foreach my $k ( @rel_link_num ) {
463 :     my ( $ss, $key, @value ) = @$k;
464 :     $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>";
465 :     $linksvoid .= $value[0]." ".$value[1]."\n";
466 :     }
467 :    
468 :     return ( $linksstring, $linksvoid );
469 :     }
470 :    
471 : bartels 1.10 ########################################
472 :     # set Literature-string for subsystems #
473 :     ########################################
474 :     sub setLiteratures {
475 :     my ( $fig, $name, $newpubs ) = @_;
476 :    
477 : bartels 1.15 my $esc_name = uri_escape($name);
478 :    
479 : bartels 1.10 my @values;
480 : bartels 1.15 my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$esc_name, "SUBSYSTEM_PUBMED_RELEVANT" );
481 : bartels 1.10
482 :     foreach my $k ( @rel_lit_num ) {
483 :     my ( $ss, $key, $value ) = @$k;
484 : bartels 1.15 $fig->delete_matching_attributes( "Subsystem:$esc_name", "SUBSYSTEM_PUBMED_RELEVANT", $value );
485 : bartels 1.10 }
486 :    
487 :     foreach my $np ( @$newpubs ) {
488 : bartels 1.15 $fig->add_attribute( "Subsystem:$esc_name", "SUBSYSTEM_PUBMED_RELEVANT", $np );
489 : bartels 1.10 }
490 :     }
491 :    
492 : bartels 1.13 ########################################
493 :     # set Literature-string for subsystems #
494 :     ########################################
495 :     sub setWeblinks {
496 :     my ( $fig, $name, $newpubs ) = @_;
497 :    
498 : bartels 1.15 my $esc_name = uri_escape($name);
499 :    
500 : bartels 1.13 my @values;
501 : bartels 1.15 my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$esc_name, "SUBSYSTEM_WEBLINKS" );
502 : bartels 1.13
503 :     foreach my $k ( @rel_lit_num ) {
504 :     my ( $ss, $key, $value ) = @$k;
505 : bartels 1.15 $fig->delete_matching_attributes( "Subsystem:$esc_name", "SUBSYSTEM_WEBLINKS", $value );
506 : bartels 1.13 }
507 :    
508 :     foreach my $np ( @$newpubs ) {
509 :     my @h = split( /\s+/, $np );
510 : bartels 1.15 $fig->add_attribute( "Subsystem:$esc_name", "SUBSYSTEM_WEBLINKS", @h );
511 : bartels 1.13 }
512 :     }
513 :    
514 : bartels 1.2 sub supported_rights {
515 :    
516 :     return [ [ 'edit', 'subsystem', '*' ] ];
517 :    
518 : bartels 1.1 }
519 : bartels 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3