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

Diff of /SubsystemEditor/WebPage/ShowSubsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Tue Jul 31 21:54:24 2007 UTC revision 1.28, Wed Jun 17 15:14:19 2009 UTC
# Line 12  Line 12 
12    
13  1;  1;
14    
15  ##################################################  ##############################################################
16  # Method for registering components etc. for the #  # Method for registering components etc. for the application #
17  # application                                    #  ##############################################################
 ##################################################  
18  sub init {  sub init {
19    my ( $self ) = @_;    my ( $self ) = @_;
20    
21    $self->application->register_component(  'Table', 'sstable'  );    $self->application->register_component(  'Table', 'sstable'  );
22      $self->application->register_component(  'Table', 'VarDescTable'  );
23    }
24    
25    #################################
26    # File where Javascript resides #
27    #################################
28    sub require_javascript {
29    
30      return [ './Html/showfunctionalroles.js' ];
31    
32  }  }
33    
34  ##############################################  ##############################################
# Line 28  Line 37 
37  sub output {  sub output {
38    my ( $self ) = @_;    my ( $self ) = @_;
39    
40    my $fig = new FIG;    my $fig = $self->application->data_handle( 'FIG' );
41    my $cgi = $self->application->cgi;    my $cgi = $self->application->cgi;
42    
43      # subsystem name and 'nice name' #
44    my $name = $cgi->param( 'subsystem' );    my $name = $cgi->param( 'subsystem' );
45      $name = uri_unescape( $name );
46      $name =~ s/&#39/'/g;
47    my $ssname = $name;    my $ssname = $name;
48    $ssname =~ s/\_/ /g;    $ssname =~ s/\_/ /g;
49    
50      # look if someone is logged in and can write the subsystem #
51      my $can_alter = 0;
52      my $user = $self->application->session->user;
53    
54      my $dbmaster = $self->application->dbmaster;
55      my $ppoapplication = $self->application->backend;
56    
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      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          my $su = lc( $seeduser );
78          my $cu = lc( $curatorOfSS );
79          if ( $su eq $cu ) {
80            # 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      }
94    
95    ######################    ######################
96    # Construct the menu #    # Construct the menu #
97    ######################    ######################
98    
99    my $menu = $self->application->menu();    my $menu = $self->application->menu();
100    
101      my $esc_name = uri_escape($name);
102    
103    # Build nice tab menu here    # Build nice tab menu here
104    $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$name" );    $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$esc_name" );
105    $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$name" );    $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$esc_name" );
106    $menu->add_category( 'Subsystem Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$name" );    $menu->add_category( 'Subsets', "SubsysEditor.cgi?page=ShowSubsets&subsystem=$esc_name" );
107    $menu->add_category( 'Subsystem Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$name" );    $menu->add_category( 'Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$esc_name" );
108    $menu->add_category( 'Subsystem Tree', "SubsysEditor.cgi?page=ShowTree&subsystem=$name" );    $menu->add_category( 'Illustrations', "SubsysEditor.cgi?page=ShowIllustrations&subsystem=$esc_name" );
109      $menu->add_category( 'Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$esc_name" );
110      $menu->add_category( 'Show Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$esc_name" );
111      $menu->add_category( 'Show Connections', "SubsysEditor.cgi?page=ShowTree&subsystem=$esc_name" );
112    
113    
114    ##############################    ##############################
115    # Construct the page content #    # Construct the page content #
116    ##############################    ##############################
117    
118    my $content = "<H2>Subsystem Info</H2>";    my $content = qq~
119    <STYLE>
120    .hideme {
121       display: none;
122    }
123    .showme {
124       display: all;
125    }
126    </STYLE>
127    ~;
128    
129      $content .= "<H2>Subsystem Info</H2>";
130      my $subsystem = new Subsystem( $name, $fig, 0 );
131    
132      if ( defined( $cgi->param( 'SUBMIT' ) ) ) {
133    
134        # set description and notes
135        my $descrp = $cgi->param( 'SSDESC' );
136        chomp $descrp;
137        $descrp .= "\n";
138        $subsystem->set_description( $descrp );
139        my $notes = $cgi->param( 'SSNOTES' );
140        chomp $notes;
141        $notes .= "\n";
142        $subsystem->set_notes( $notes );
143    
144        my $class1 = '';
145        my $class2 = '';
146    
147        if ( defined( $cgi->param( 'Classification' ) ) ) {
148          if ( $cgi->param( 'Classification' ) eq 'User-defined' ) {
149            if ( defined( $cgi->param( "SUBSYSH1TF" ) ) ) {
150              $class1 = $cgi->param( "SUBSYSH1TF" );
151            }
152          }
153          else {
154            if ( defined( $cgi->param( "SUBSYSH1" ) ) ) {
155              $class1 = $cgi->param( "SUBSYSH1" );
156            }
157          }
158        }
159    
160        if ( defined( $cgi->param( 'Classification' ) ) ) {
161          if ( $cgi->param( 'Classification' ) eq 'User-defined' ) {
162            if ( defined( $cgi->param( "SUBSYSH2TF" ) ) ) {
163              $class2 = $cgi->param( "SUBSYSH2TF" );
164            }
165          }
166          else {
167            if ( defined( $cgi->param( "SUBSYSH2" ) ) ) {
168              $class2 = $cgi->param( "SUBSYSH2" );
169            }
170          }
171        }
172        $subsystem->set_classification( [ $class1, $class2 ] );
173    
174        my $litstoset = $cgi->param( 'SUBSYSLIT' );
175        $litstoset =~ s/ //g;
176        my @lits = split( ',', $litstoset );
177        setLiteratures( $fig, $name, \@lits );
178    
179        my $wlstoset = $cgi->param( 'SUBSYSWL' );
180        if ( defined( $wlstoset ) && $wlstoset =~ /.+\s+.+/ ) {
181          my @wls = split( '\n', $wlstoset );
182          setWeblinks( $fig, $name, \@wls );
183        }
184    
185        # here we really edit the files in the subsystem directory #
186        $subsystem->incr_version();
187        $subsystem->db_sync();
188        $subsystem->write_subsystem();
189      }
190      elsif ( defined( $cgi->param( 'GrantRightButton' ) ) ) {
191        if ( $can_alter && $user->has_right( undef, 'edit', 'subsystem', $name, 1 ) ) {
192          my $newAnno = $cgi->param( 'ANNOBOX' );
193          my $thisUsers = $dbmaster->User->get_objects( { login => $newAnno } );
194          if ( defined( $thisUsers->[0] ) ) {
195    
196            my $rights = $dbmaster->Rights->get_objects( { name => 'edit',
197                                                           data_type => 'subsystem',
198                                                           data_id => $name,
199                                                           scope => $thisUsers->[0]->get_user_scope() } );
200            if ( defined( $rights->[0] ) ) {
201              $self->application->add_message( 'warning', "User $newAnno already has the right to edit this subsystem." );
202            }
203            else {
204              my $right = $dbmaster->Rights->create( { granted => 1,
205                                                       delegated => 1,
206                                                       name => 'edit',
207                                                       data_type => 'subsystem',
208                                                       data_id => $name,
209                                                       scope => $thisUsers->[0]->get_user_scope() } );
210              if ( $right ) {
211                $self->application->add_message( 'info', "$newAnno can now edit this subsystem" );
212              }
213              else {
214                $self->application->add_message( 'warning', "Could not create right to edit the subsystem for user $newAnno" );
215              }
216            }
217          }
218        }
219        else {
220          $self->application->add_message( 'warning', "You do not have the right to share the subsystem." );
221        }
222      }
223      elsif ( defined( $cgi->param( 'RevokeRightButton' ) ) ) {
224        if ( $can_alter && $user->has_right( undef, 'edit', 'subsystem', $name, 1 ) ) {
225          my $newAnno = $cgi->param( 'ALANNOBOX' );
226          my $thisUsers = $dbmaster->User->get_objects( { login => $newAnno } );
227          my $rights = $dbmaster->Rights->get_objects( { name => 'edit',
228                                                         data_type => 'subsystem',
229                                                         data_id => $name,
230                                                         scope => $thisUsers->[0]->get_user_scope() } );
231    
232          my $thisRight = $rights->[0];
233          if ( defined( $thisRight ) && $thisRight->delegated ) {
234            $thisRight->delete();
235    
236            $self->application->add_message( 'info', "$newAnno cannot edit this subsystem any more." );
237          }
238          else {
239            $self->application->add_message( 'warning', "You can't revoke the right of $newAnno to edit this subsystem." );
240          }
241        }
242        else {
243          $self->application->add_message( 'warning', "You do not have the right to revoke rights for this subsystem." );
244        }
245      }
246    
247      $subsystem = new Subsystem( $name, $fig, 0 );
248    
249      $content .= $self->start_form( 'form', { subsystem => $name } );
250    
251    my ( $ssversion, $sscurator, $pedigree, $ssroles ) = $fig->subsystem_info( $name );    my ( $ssversion, $sscurator, $pedigree, $ssroles ) = $fig->subsystem_info( $name );
252    
253      my $versionlink = '';
254    
255      if ( $can_alter ) {
256        $versionlink = " -- <A HREF='".$self->application->url()."?page=ResetSubsystem&subsystem=$esc_name'>Reset to Previous Timestamp</A>";
257      }
258    
259    my $mod_time = get_mod_time( $name );    my $mod_time = get_mod_time( $name );
260    my $class = $fig->subsystem_classification( $name );    my $class = $fig->subsystem_classification( $name );
   my $subsystem = new Subsystem( $name, $fig, 0 );  
261    my $ssnotes = $subsystem->get_notes();    my $ssnotes = $subsystem->get_notes();
   my $ssdesc = "";  
262    
263      if ( !defined( $ssnotes ) ) {
264        $ssnotes = '';
265      }
266      my $ssdesc = $subsystem->get_description();
267    
268    my $infotable = "<TABLE><TR><TH>Name:</TH><TD>$ssname</TD><TR>";    if ( !defined( $ssdesc ) ) {
269        $ssdesc = '';
270      }
271    
272      my $classification_stuff;
273      if ( $can_alter ) {
274        $classification_stuff = get_classification_boxes( $fig, $cgi, $class->[0], $class->[1] );
275      }
276      else {
277        $classification_stuff = "<TR><TH>Classification:</TH><TD>$class->[0]</TD></TR>";
278        $classification_stuff .= "<TR><TH></TH><TD>$class->[1]</TD></TR>";
279      }
280    
281      my $infotable = "<TABLE><TR><TH>Name:</TH><TD>$ssname</TD></TR>";
282    $infotable .= "<TR><TH>Author:</TH><TD>$sscurator</TD></TR>";    $infotable .= "<TR><TH>Author:</TH><TD>$sscurator</TD></TR>";
283    $infotable .= "<TR><TH>Version:</TH><TD>$ssversion</TD></TR>";    if ( $can_alter && $user->has_right( undef, 'edit', 'subsystem', $name, 1 ) && !$self->application->{anonymous_mode}) {
284    
285        my $annoGrp = $dbmaster->Scope->get_objects( { name => 'Annotators' } );
286        my $annoScope = $dbmaster->UserHasScope->get_objects( { scope => $annoGrp->[0] } );
287        my $annoMems = [];
288        foreach my $aS ( @$annoScope ) {
289          push @$annoMems, $aS->user();
290        }
291        @$annoMems = sort { $a->lastname cmp $b->lastname || $a->firstname cmp $b->firstname } @$annoMems;
292    
293        my $editRightButton = "<INPUT TYPE=SUBMIT ID='GrantRightButton' NAME='GrantRightButton' VALUE='Grant Right'>";
294        my $revokeRightButton = "<INPUT TYPE=SUBMIT ID='RevokeRightButton' NAME='RevokeRightButton' VALUE='Revoke Right'>";
295    
296        my $annotatorsBox = "<SELECT NAME='ANNOBOX' ID='ANNOBOX'>";
297        my $alreadyAnnotatorsBox = "<SELECT NAME='ALANNOBOX' ID='ALANNOBOX'>";
298        foreach my $a ( @$annoMems ) {
299          unless ( $a->has_right( undef, 'edit', 'subsystem', $name ) ) {
300            $annotatorsBox .= "<OPTION VALUE='".$a->login."'>".$a->firstname.' '.$a->lastname.' ( '.$a->login." )</OPTION>";
301          }
302          else {
303            if ( $a->login() ne $user->login() && ( ! $a->has_right( undef, 'edit', 'subsystem', '*' ) ) ) {
304              $alreadyAnnotatorsBox .= "<OPTION VALUE='".$a->login."'>".$a->firstname.' '.$a->lastname.' ( '.$a->login." )</OPTION>";
305            }
306          }
307        }
308        $annotatorsBox .= "</SELECT>";
309        $alreadyAnnotatorsBox .= "</SELECT>";
310    
311        $infotable .= "<TR><TH>Grant Right To Edit To:</TH><TD>$annotatorsBox $editRightButton</TD></TR>";
312        $infotable .= "<TR><TH>Revoke Right To Edit From:</TH><TD>$alreadyAnnotatorsBox $revokeRightButton</TD></TR>";
313      }
314      $infotable .= "<TR><TH>Version:</TH><TD>$ssversion $versionlink</TD></TR>";
315    $infotable .= "<TR><TH>Last Modified:</TH><TD>$mod_time</TD></TR>";    $infotable .= "<TR><TH>Last Modified:</TH><TD>$mod_time</TD></TR>";
316    $infotable .= "<TR><TH>Classification:</TH><TD>$class->[0]</TD></TR>";  
317    $infotable .= "<TR><TH></TH><TD>$class->[1]</TD></TR>";    # Literature #
318    $infotable .= "<TR><TH>Description</TH><TD><TEXTAREA NAME='SSDESC' ROWS=6 STYLE='width: 772px;'>$ssdesc</TEXTAREA></TD></TR>";    my $lit = getLiteratures( $fig, $name );
319    $infotable .= "<TR><TH>Notes</TH><TD><TEXTAREA NAME='SSNOTES' ROWS=6 STYLE='width: 772px;'>$ssnotes</TEXTAREA></TD></TR>";    my $litstring = '';
320      my $litvoid = '';
321      if ( defined( $lit ) && scalar( @$lit ) > 0 ) {
322        my @litlinks;
323        foreach my $l ( @$lit ) {
324          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>";
325          push @litlinks, $thislink;
326        }
327        $litstring = join( ', ', @litlinks );
328        $litvoid = join( ', ', @$lit );
329      }
330    
331      # Weblinks #
332      my ( $wl, $wlvoid ) = getLinks( $fig, $name );
333    
334      my $variants = $subsystem->get_variants();
335    
336      if ( $can_alter ) {
337    
338        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\" );'>";
339        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\" );'>";
340    
341        $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>";
342        $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>";
343        $infotable .= "<TR><TH>Description</TH><TD><TEXTAREA NAME='SSDESC' ROWS=15 STYLE='width: 772px;'>$ssdesc</TEXTAREA></TD></TR>";
344        $infotable .= "<TR><TH>Notes</TH><TD><TEXTAREA NAME='SSNOTES' ROWS=15 STYLE='width: 772px;'>$ssnotes</TEXTAREA></TD></TR>";
345      }
346      else {
347        # do a little formating because the notes often contain many many blanks and newlines
348        my $ssdesc_brs = $ssdesc;
349        $ssdesc_brs =~ s/\n/<BR>/g;
350        $ssdesc_brs =~ s/(\n\s)+/\n/g;
351        my $ssnotes_brs = $ssnotes;
352        $ssnotes_brs =~ s/(\n\s)+/\n/g;
353        $ssnotes_brs =~ s/\n/<BR>/g;
354        $infotable .= "<TR><TH>Literature</TH><TD>$litstring</TD></TR>";
355        $infotable .= "<TR><TH>Websites</TH><TD>$wl</TD></TR>";
356        $infotable .= "<TR><TH>Description</TH><TD>$ssdesc_brs</TD></TR>";
357        $infotable .= "<TR><TH>Notes</TH><TD>$ssnotes_brs</TD></TR>";
358      }
359      # variants
360      my $vartable = $self->application->component( 'VarDescTable' );
361      $vartable->columns( [ { name => "Variant" }, { name => "Description" } ] );
362    
363      my $vardata;
364      my $has_variants = 0;
365      foreach my $kv ( sort keys %$variants ) {
366        $has_variants = 1;
367        push @$vardata, [ $kv, $variants->{ $kv } ];
368      }
369      $vartable->data( $vardata );
370      $infotable .= "<TR><TH>Variants</TH><TD>";
371      if ( $has_variants ) {
372        $infotable .= $vartable->output();
373      }
374    
375      if ( $can_alter ) {
376        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\" )'>";
377      $infotable .= $variant_outside;
378      }
379    
380      $infotable .= "</TD</TR>";
381    
382      $infotable .= $classification_stuff;
383    $infotable .= "</TABLE>";    $infotable .= "</TABLE>";
384    
385      if ( $can_alter ) {
386        $infotable .= "<INPUT TYPE=SUBMIT VALUE='Save Changes' ID='SUBMIT' NAME='SUBMIT' STYLE='background-color: red;'>";
387      }
388    
389      if ( $can_alter ) {
390        $content .= "<INPUT TYPE=SUBMIT VALUE='Save Changes' ID='SUBMIT' NAME='SUBMIT'  STYLE='background-color: red;'>";
391      }
392    $content .= $infotable;    $content .= $infotable;
393      $content .= $self->end_form();
394    
395    return $content;    return $content;
396  }  }
# Line 99  Line 416 
416    }    }
417        return "$FIG_Config::data/Subsystems/$ssa/Backup";        return "$FIG_Config::data/Subsystems/$ssa/Backup";
418  }  }
419    
420    
421    sub get_classification_boxes {
422      my ( $fig, $cgi, $class1, $class2 ) = @_;
423      my $classified = 1;
424    
425      my $sdContent = '';
426      my $SUBSYSH1 = $class1;
427      my $SUBSYSH2 = $class2;
428    
429      # variables that monitor if we have selected a box
430      my $putinh1 = 0;
431      my $putinh2 = 0;
432    
433      if ( !defined( $SUBSYSH1 ) ){
434        $putinh1 = 1;
435      }
436      if ( !defined( $SUBSYSH2 ) ){
437        $putinh2 = 1;
438      }
439    
440      my $inh1 = '';
441      if ( defined( $cgi->param( 'SUBSYSH1TF' ) ) ) {
442        $inh1 = $cgi->param( 'SUBSYSH1TF' );
443      }
444      elsif ( defined( $SUBSYSH1 ) ) {
445        if ( !$putinh1 ) {
446          $inh1 = $SUBSYSH1;
447        }
448      }
449      my $inh2 = '';
450      if ( defined( $cgi->param( 'SUBSYSH2TF' ) ) ) {
451        $inh2 = $cgi->param( 'SUBSYSH2TF' );
452      }
453      elsif ( defined( $SUBSYSH2 ) ) {
454        if ( !$putinh2 ) {
455          $inh2 = $SUBSYSH2;
456        }
457      }
458    
459      my @ssclassifications = $fig->all_subsystem_classifications();
460      my $ssclass;
461      foreach my $ssc ( @ssclassifications ) {
462        if ( !defined( $ssc->[1] ) ) {
463          $ssc->[1] = '';
464        }
465    #    next if ( ( !defined( $ssc->[0] ) ) || ( !defined( $ssc->[1] ) ) );
466        next if ( !defined( $ssc->[0] ) );
467        next if ( $ssc->[0] eq '' );
468    #    next if ( ( $ssc->[0] eq '' ) || ( $ssc->[1] eq '' ) );
469        next if ( ( $ssc->[0] =~ /^\s+$/ ) || ( $ssc->[1] =~ /^\s+$/ ) );
470        push @{ $ssclass->{ $ssc->[0] } }, $ssc->[1];
471      }
472    
473    
474      my @options;
475      foreach my $firstc ( keys %$ssclass ) {
476        my $opt = "<SELECT SIZE=5 ID='$firstc' NAME='SUBSYSH2' STYLE='width: 386px;' class='hideme'>";
477        my $optstring = '';
478        foreach my $secc ( sort @{ $ssclass->{ $firstc } } ) {
479          if ( defined( $SUBSYSH2 ) && $SUBSYSH2 eq $secc && $SUBSYSH1 eq $firstc ) {
480            $optstring .= "<OPTION SELECTED VALUE='$secc'>$secc</OPTION>";
481            # we have to show the selectbox if there is a selected value
482            $opt = "<SELECT SIZE=5 ID='$firstc' NAME='SUBSYSH2' STYLE='width: 386px;' class='showme'>";
483            $putinh2 = 1;
484          }
485          else {
486            $optstring .= "<OPTION VALUE='$secc'>$secc</OPTION>";
487          }
488        }
489        $opt .= $optstring;
490        $opt .= "</SELECT>";
491        push @options, $opt;
492      }
493    
494      if ( $classified ) {
495        $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();'>";
496      }
497      else {
498        $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>";
499      }
500      foreach my $firstc ( sort keys %$ssclass ) {
501        if ( defined( $SUBSYSH1 ) && $SUBSYSH1 eq $firstc ) {
502          $sdContent .= "\n<OPTION SELECTED VALUE='$firstc'>$firstc</OPTION>\n";
503          $putinh1 = 1;
504        }
505        else {
506          $sdContent .= "\n<OPTION VALUE='$firstc'>$firstc</OPTION>\n";
507        }
508      }
509      $sdContent .= "</SELECT>";
510    
511      foreach my $opt ( @options ) {
512        $sdContent .= $opt;
513      }
514    
515      $sdContent .= "</TD></TR>";
516      if ( $classified ) {
517        $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>";
518      }
519      else {
520        $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>";
521      }
522    
523    
524      return $sdContent;
525    }
526    
527    ########################################
528    # get Literature-string for subsystems #
529    ########################################
530    sub getLiteratures {
531      my ( $fig, $name ) = @_;
532    
533      my $esc_name = uri_escape($name);
534    
535      my $frpubs;
536      my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$name, "SUBSYSTEM_PUBMED_RELEVANT" );
537    
538      foreach my $k ( @rel_lit_num ) {
539        my ( $ss, $key, $value ) = @$k;
540        push @$frpubs, $value;
541      }
542    
543      return $frpubs;
544    }
545    
546    ######################################
547    # get Weblinks-string for subsystems #
548    ######################################
549    sub getLinks {
550      my ( $fig, $name ) = @_;
551    
552      my $esc_name = uri_escape($name);
553    
554      my $links;
555      my $linksstring = '';
556      my $linksvoid = '';
557      my @rel_link_num = $fig->get_attributes( 'Subsystem:'.$name, "SUBSYSTEM_WEBLINKS" );
558    
559      foreach my $k ( @rel_link_num ) {
560        my ( $ss, $key, @value ) = @$k;
561        $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>";
562        $linksvoid .= $value[0]." ".$value[1]."\n";
563      }
564    
565      return ( $linksstring, $linksvoid );
566    }
567    
568    ########################################
569    # set Literature-string for subsystems #
570    ########################################
571    sub setLiteratures {
572      my ( $fig, $name, $newpubs ) = @_;
573    
574      my $esc_name = uri_escape($name);
575    
576      my @values;
577      my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$name, "SUBSYSTEM_PUBMED_RELEVANT" );
578    
579      foreach my $k ( @rel_lit_num ) {
580        my ( $ss, $key, $value ) = @$k;
581        $fig->delete_matching_attributes( "Subsystem:$name", "SUBSYSTEM_PUBMED_RELEVANT" );
582      }
583    
584      foreach my $np ( @$newpubs ) {
585        $fig->add_attribute( "Subsystem:$name", "SUBSYSTEM_PUBMED_RELEVANT", $np );
586      }
587    }
588    
589    ########################################
590    # set Literature-string for subsystems #
591    ########################################
592    sub setWeblinks {
593      my ( $fig, $name, $newpubs ) = @_;
594    
595      my $esc_name = uri_escape($name);
596    
597      my @values;
598      my @rel_lit_num = $fig->get_attributes( 'Subsystem:'.$name, "SUBSYSTEM_WEBLINKS" );
599    
600      foreach my $k ( @rel_lit_num ) {
601        my ( $ss, $key, $value ) = @$k;
602        $fig->delete_matching_attributes( "Subsystem:$name", "SUBSYSTEM_WEBLINKS" );
603      }
604    
605      foreach my $np ( @$newpubs ) {
606        my @h = split( /\s+/, $np );
607        $fig->add_attribute( "Subsystem:$name", "SUBSYSTEM_WEBLINKS", @h );
608      }
609    }
610    
611    sub supported_rights {
612    
613      return [ [ 'edit', 'subsystem', '*' ] ];
614    
615    }
616    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.28

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3