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

Annotation of /SubsystemEditor/WebPage/ShowSubsystem.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (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 :     use Data::Dumper;
40 :    
41 : bartels 1.1 my $fig = new FIG;
42 :     my $cgi = $self->application->cgi;
43 :    
44 : bartels 1.2 # subsystem name and 'nice name' #
45 : bartels 1.1 my $name = $cgi->param( 'subsystem' );
46 :     my $ssname = $name;
47 :     $ssname =~ s/\_/ /g;
48 :    
49 : bartels 1.2 # look if someone is logged in and can write the subsystem #
50 :     my $can_alter = 0;
51 :     my $user = $self->application->session->user;
52 : bartels 1.4
53 :     my $dbmaster = DBMaster->new( -database => 'WebAppBackend' );
54 :     my $ppoapplication = $dbmaster->Backend->init( { name => 'SubsystemEditor' } );
55 :    
56 :     # get a seeduser #
57 :     my $seeduser = '';
58 :     if ( defined( $user ) && ref( $user ) ) {
59 :     my $preferences = $dbmaster->Preferences->get_objects( { user => $user,
60 :     name => 'SeedUser',
61 :     application => $ppoapplication } );
62 :     if ( defined( $preferences->[0] ) ) {
63 :     $seeduser = $preferences->[0]->value();
64 :     }
65 :     }
66 :    
67 : bartels 1.2 if ( $user && $user->has_right( $self->application, 'edit', 'subsystem', $name ) ) {
68 :     $can_alter = 1;
69 : bartels 1.4 $fig->set_user( $seeduser );
70 : bartels 1.2 }
71 : bartels 1.1 ######################
72 :     # Construct the menu #
73 :     ######################
74 :    
75 :     my $menu = $self->application->menu();
76 :    
77 :     # Build nice tab menu here
78 :     $menu->add_category( 'Subsystem Info', "SubsysEditor.cgi?page=ShowSubsystem&subsystem=$name" );
79 :     $menu->add_category( 'Functional Roles', "SubsysEditor.cgi?page=ShowFunctionalRoles&subsystem=$name" );
80 :     $menu->add_category( 'Subsystem Diagram', "SubsysEditor.cgi?page=ShowDiagram&subsystem=$name" );
81 :     $menu->add_category( 'Subsystem Spreadsheet', "SubsysEditor.cgi?page=ShowSpreadsheet&subsystem=$name" );
82 : bartels 1.2 $menu->add_category( 'Subsystem Check', "SubsysEditor.cgi?page=ShowCheck&subsystem=$name" );
83 : bartels 1.1 $menu->add_category( 'Subsystem Tree', "SubsysEditor.cgi?page=ShowTree&subsystem=$name" );
84 :    
85 :    
86 :     ##############################
87 :     # Construct the page content #
88 :     ##############################
89 :    
90 : bartels 1.2 my $content = qq~
91 :     <STYLE>
92 :     .hideme {
93 :     display: none;
94 :     }
95 :     .showme {
96 :     display: all;
97 :     }
98 :     </STYLE>
99 :     ~;
100 :    
101 :     $content .= "<H2>Subsystem Info</H2>";
102 :     my $subsystem = new Subsystem( $name, $fig, 0 );
103 :    
104 :     if ( defined( $cgi->param( 'SUBMIT' ) ) ) {
105 :    
106 :     # set description and notes
107 :     my $descrp = $cgi->param( 'SSDESC' );
108 :     chomp $descrp;
109 :     $descrp .= "\n";
110 :     $subsystem->set_description( $descrp );
111 :     my $notes = $cgi->param( 'SSNOTES' );
112 :     chomp $notes;
113 :     $notes .= "\n";
114 :     $subsystem->set_notes( $notes );
115 :    
116 :     my $class1 = '';
117 :     my $class2 = '';
118 :    
119 :     if ( defined( $cgi->param( 'Classification' ) ) ) {
120 :     if ( $cgi->param( 'Classification' ) eq 'User-defined' ) {
121 :     if ( defined( $cgi->param( "SUBSYSH1TF" ) ) ) {
122 :     $class1 = $cgi->param( "SUBSYSH1TF" );
123 :     }
124 :     }
125 :     else {
126 :     if ( defined( $cgi->param( "SUBSYSH1" ) ) ) {
127 :     $class1 = $cgi->param( "SUBSYSH1" );
128 :     }
129 :     }
130 :     }
131 :    
132 :     if ( defined( $cgi->param( 'Classification' ) ) ) {
133 :     if ( $cgi->param( 'Classification' ) eq 'User-defined' ) {
134 :     if ( defined( $cgi->param( "SUBSYSH2TF" ) ) ) {
135 :     $class2 = $cgi->param( "SUBSYSH2TF" );
136 :     }
137 :     }
138 :     else {
139 :     if ( defined( $cgi->param( "SUBSYSH2" ) ) ) {
140 :     $class2 = $cgi->param( "SUBSYSH2" );
141 :     }
142 :     }
143 :     }
144 :     $subsystem->set_classification( [ $class1, $class2 ] );
145 :    
146 :     # here we really edit the files in the subsystem directory #
147 :     $subsystem->incr_version();
148 :     $subsystem->db_sync();
149 :     $subsystem->write_subsystem();
150 :     }
151 : bartels 1.1
152 : bartels 1.2 $subsystem = new Subsystem( $name, $fig, 0 );
153 :    
154 :     $content .= $self->start_form( 'form', { subsystem => $name } );
155 :    
156 : bartels 1.1 my ( $ssversion, $sscurator, $pedigree, $ssroles ) = $fig->subsystem_info( $name );
157 : bartels 1.3
158 :     my $versionlink = '';
159 :     print STDERR $can_alter." CANALTER\n";
160 :     if ( $can_alter ) {
161 : bartels 1.4 $versionlink = " -- <A HREF='".$self->application->url()."?page=ResetSubsystem&subsystem=$name'>Reset to Previous Timestamp</A>";
162 : bartels 1.3 print STDERR $versionlink . " VL\n";
163 :     }
164 :    
165 : bartels 1.1 my $mod_time = get_mod_time( $name );
166 :     my $class = $fig->subsystem_classification( $name );
167 :     my $ssnotes = $subsystem->get_notes();
168 :    
169 : bartels 1.2 if ( !defined( $ssnotes ) ) {
170 :     $ssnotes = '';
171 :     }
172 :     my $ssdesc = $subsystem->get_description();
173 :    
174 :     if ( !defined( $ssdesc ) ) {
175 :     $ssdesc = '';
176 :     }
177 :    
178 :     my $classification_stuff;
179 :     if ( $can_alter ) {
180 :     $classification_stuff = get_classification_boxes( $fig, $cgi, $class->[0], $class->[1] );
181 :     }
182 :     else {
183 :     $classification_stuff = "<TR><TH>Classification:</TH><TD>$class->[0]</TD></TR>";
184 :     $classification_stuff .= "<TR><TH></TH><TD>$class->[1]</TD></TR>";
185 :     }
186 : bartels 1.1
187 : bartels 1.3 print STDERR $versionlink . " VL\n";
188 : bartels 1.1 my $infotable = "<TABLE><TR><TH>Name:</TH><TD>$ssname</TD><TR>";
189 :     $infotable .= "<TR><TH>Author:</TH><TD>$sscurator</TD></TR>";
190 : bartels 1.3 $infotable .= "<TR><TH>Version:</TH><TD>$ssversion $versionlink</TD></TR>";
191 : bartels 1.1 $infotable .= "<TR><TH>Last Modified:</TH><TD>$mod_time</TD></TR>";
192 : bartels 1.2 if ( $can_alter ) {
193 :     $infotable .= "<TR><TH>Description</TH><TD><TEXTAREA NAME='SSDESC' ROWS=6 STYLE='width: 772px;'>$ssdesc</TEXTAREA></TD></TR>";
194 :     $infotable .= "<TR><TH>Notes</TH><TD><TEXTAREA NAME='SSNOTES' ROWS=6 STYLE='width: 772px;'>$ssnotes</TEXTAREA></TD></TR>";
195 :     }
196 :     else {
197 :     # do a little formating because the notes often contain many many blanks and newlines
198 :     my $ssdesc_brs = $ssdesc;
199 :     $ssdesc_brs =~ s/\n/<BR>/g;
200 :     $ssdesc_brs =~ s/(\n\s)+/\n/g;
201 :     my $ssnotes_brs = $ssnotes;
202 :     $ssnotes_brs =~ s/(\n\s)+/\n/g;
203 :     $ssnotes_brs =~ s/\n/<BR>/g;
204 :     $infotable .= "<TR><TH>Description</TH><TD>$ssdesc_brs</TD></TR>";
205 :     $infotable .= "<TR><TH>Notes</TH><TD>$ssnotes_brs</TD></TR>";
206 :     }
207 :     $infotable .= $classification_stuff;
208 : bartels 1.1 $infotable .= "</TABLE>";
209 :    
210 : bartels 1.2 if ( $can_alter ) {
211 :     $infotable .= "<INPUT TYPE=SUBMIT VALUE='Save Changes' ID='SUBMIT' NAME='SUBMIT'>";
212 :     }
213 :    
214 : bartels 1.1 $content .= $infotable;
215 : bartels 1.2 $content .= $self->end_form();
216 : bartels 1.1
217 :     return $content;
218 :     }
219 :    
220 :    
221 :     sub get_mod_time {
222 :    
223 :     my ( $ssa, $fig ) = @_;
224 :    
225 :     my( $t, @spreadsheets );
226 :     if ( opendir( BACKUP, "$FIG_Config::data/Subsystems/$ssa/Backup" ) ) {
227 :    
228 :     @spreadsheets = sort { $b <=> $a }
229 :     map { $_ =~ /^spreadsheet.(\d+)/; $1 }
230 :     grep { $_ =~ /^spreadsheet/ }
231 :     readdir(BACKUP);
232 :     closedir(BACKUP);
233 :    
234 :     if ( $t = shift @spreadsheets ) {
235 :     my $last_modified = &FIG::epoch_to_readable( $t );
236 :     return $last_modified;
237 :     }
238 :     }
239 : bartels 1.2 return "$FIG_Config::data/Subsystems/$ssa/Backup";
240 :     }
241 :    
242 :    
243 :     sub get_classification_boxes {
244 :     my ( $fig, $cgi, $class1, $class2 ) = @_;
245 :     my $classified = 1;
246 :    
247 :     my $sdContent = '';
248 :     my $SUBSYSH1 = $class1;
249 :     my $SUBSYSH2 = $class2;
250 :    
251 :     # variables that monitor if we have selected a box
252 :     my $putinh1 = 0;
253 :     my $putinh2 = 0;
254 :    
255 :     if ( !defined( $SUBSYSH1 ) ){
256 :     $putinh1 = 1;
257 :     }
258 :     if ( !defined( $SUBSYSH2 ) ){
259 :     $putinh2 = 1;
260 :     }
261 :    
262 :     my $inh1 = '';
263 :     if ( defined( $cgi->param( 'SUBSYSH1TF' ) ) ) {
264 :     $inh1 = $cgi->param( 'SUBSYSH1TF' );
265 :     }
266 :     elsif ( defined( $SUBSYSH1 ) ) {
267 :     if ( !$putinh1 ) {
268 :     $inh1 = $SUBSYSH1;
269 :     }
270 :     }
271 :     my $inh2 = '';
272 :     if ( defined( $cgi->param( 'SUBSYSH2TF' ) ) ) {
273 :     $inh2 = $cgi->param( 'SUBSYSH2TF' );
274 :     }
275 :     elsif ( defined( $SUBSYSH2 ) ) {
276 :     if ( !$putinh2 ) {
277 :     $inh2 = $SUBSYSH2;
278 :     }
279 :     }
280 :    
281 :     my @ssclassifications = $fig->all_subsystem_classifications();
282 :     my $ssclass;
283 :     foreach my $ssc ( @ssclassifications ) {
284 :     next if ( ( !defined( $ssc->[0] ) ) || ( !defined( $ssc->[1] ) ) );
285 :     next if ( ( $ssc->[0] eq '' ) || ( $ssc->[1] eq '' ) );
286 :     next if ( ( $ssc->[0] =~ /^\s+$/ ) || ( $ssc->[1] =~ /^\s+$/ ) );
287 :     push @{ $ssclass->{ $ssc->[0] } }, $ssc->[1];
288 :     }
289 :    
290 :    
291 :     my @options;
292 :     foreach my $firstc ( keys %$ssclass ) {
293 :     my $opt = "<SELECT SIZE=5 ID='$firstc' NAME='SUBSYSH2' STYLE='width: 386px;' class='hideme'>";
294 :     my $optstring = '';
295 :     foreach my $secc ( sort @{ $ssclass->{ $firstc } } ) {
296 :     if ( defined( $SUBSYSH2 ) && $SUBSYSH2 eq $secc ) {
297 :     $optstring .= "<OPTION SELECTED VALUE='$secc'>$secc</OPTION>";
298 :     # we have to show the selectbox if there is a selected value
299 :     $opt = "<SELECT SIZE=5 ID='$firstc' NAME='SUBSYSH2' STYLE='width: 386px;' class='showme'>";
300 :     $putinh2 = 1;
301 :     }
302 :     else {
303 :     $optstring .= "<OPTION VALUE='$secc'>$secc</OPTION>";
304 :     }
305 :     }
306 :     $opt .= $optstring;
307 :     $opt .= "</SELECT>";
308 :     push @options, $opt;
309 :     }
310 :    
311 :     if ( $classified ) {
312 :     $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();'>";
313 :     }
314 :     else {
315 :     $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>";
316 :     }
317 :     foreach my $firstc ( sort keys %$ssclass ) {
318 :     if ( defined( $SUBSYSH1 ) && $SUBSYSH1 eq $firstc ) {
319 :     $sdContent .= "\n<OPTION SELECTED VALUE='$firstc'>$firstc</OPTION>\n";
320 :     $putinh1 = 1;
321 :     }
322 :     else {
323 :     $sdContent .= "\n<OPTION VALUE='$firstc'>$firstc</OPTION>\n";
324 :     }
325 :     }
326 :     $sdContent .= "</SELECT>";
327 :    
328 :     foreach my $opt ( @options ) {
329 :     $sdContent .= $opt;
330 :     }
331 :    
332 :     $sdContent .= "</TD></TR>";
333 :     if ( $classified ) {
334 :     $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>";
335 :     }
336 :     else {
337 :     $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>";
338 :     }
339 :    
340 :    
341 :     return $sdContent;
342 :     }
343 :    
344 :     sub supported_rights {
345 :    
346 :     return [ [ 'edit', 'subsystem', '*' ] ];
347 :    
348 : bartels 1.1 }
349 : bartels 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3