[system] / trunk / webwork / system / system_webwork_setup.pl Repository:
ViewVC logotype

Annotation of /trunk/webwork/system/system_webwork_setup.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : sam 2 #!/usr/local/bin/perl
2 :     # change the above line to point to the perl program
3 :    
4 :     ################################################################################
5 :     # system_webwork_setup.pl
6 :     #
7 :     # This file changes the permissions to the correct ones in each of the
8 :     # subdirectories and the main course directory. It also modifies Global.pm and
9 :     # the various perl scripts.
10 :     #
11 :     # $Id$
12 :     ################################################################################
13 :    
14 :     #################### initialization
15 :    
16 :     require 5.000;
17 :     use strict;
18 :    
19 :     use Cwd;
20 :     use File::Copy;
21 :    
22 :     # define built-in defaults
23 :     my $DEFAULT_PERL_PATH = '/usr/bin/perl';
24 :     my $DEFAULT_CGI_URL = '/cgi-bin/webwork/system/';
25 :     my $DEFAULT_HTML_URL = '/webwork_system_html';
26 :    
27 :     # define code strings
28 :     my $CGI_DEBUG_TAG = 'WeBWorKCGIDebugURL';
29 :     my $CGI_NODEBUG_TAG = 'WeBWorKCGINoDebugURL';
30 : gage 8 my $LIB_INIT_LINE_TAG = 'WeBWorKInitLine';
31 : sam 2 my $MAIN_DIR_TAG = 'mainWeBWorKDirectory';
32 :    
33 :     # scope and undefine setup variables
34 :     our $no_prompts = undef;
35 :     our $system_setup_mode = undef;
36 :     our $mainDir = undef;
37 :     our $perlPath = undef;
38 :     our $cgiURL = undef;
39 :     our $htmlURL = undef;
40 :     our $groupName = undef;
41 :     our $update_stuff_in_courses = undef;
42 :     our $chgrp_files_and_dirs = undef;
43 :     our $chmod_files_and_dirs = undef;
44 :     our $local_preprocessor = undef;
45 :     our $local_postprocessor = undef;
46 :    
47 :     # read defaults in from defaults file
48 : gage 6 my $DEFAULTS_FILE;
49 :     if($ARGV[0]) { $DEFAULTS_FILE = $ARGV[0]; }
50 :     else { $DEFAULTS_FILE = ((getpwuid $<)[7]) . '/system_webwork_setup.defaults'; }
51 : sam 2 if(-e $DEFAULTS_FILE) {
52 :     print "Reading defaults file...";
53 :     require $DEFAULTS_FILE;
54 :     print " done.\n";
55 :     }
56 :    
57 :     #################### text strings
58 :    
59 :     my $INTRO_TEXT = q{
60 :     +----------------------+
61 :     | System Webwork Setup |
62 :     +----------------------+
63 :    
64 :     This script is used to setup the main WeBWorK system. It will create
65 :     initialization files, set groups and permissions for files and directories,
66 :     and modify files. A "demo" or "working" version of the system can be setup.
67 :    
68 :     You will need the following information:
69 :    
70 : gage 6 1) The path to perl on your system. Usually this is something like
71 : sam 2 /usr/bin/perl or /usr/local/bin/perl
72 :    
73 : gage 6 2) The group (e.g. wwadmin) containing the user names of anyone who has the
74 : sam 2 authority to modify the webwork system files. Who ever runs this script must
75 :     be a member of this group. This should be set up by your system
76 :     administrator before running this script. (Note: This is not required for a
77 :     demo version.)
78 :    
79 : gage 6 3) The cgi WeBWorK URL. Usually this is something like
80 : sam 2 http://www.math.rochester.edu/cgi-bin/webwork/system or
81 :     http://webwork.math.rochester.edu/cgi-bin/webwork/system. In the above
82 :     cases, you can just enter /cgi-bin/webwork/system which is prefered but if
83 :     you do, don't forget the initial / .
84 :    
85 : gage 6 4) The html WeBWorK URL. Usually this is something like
86 : sam 2 http://www.math.rochester.edu/webwork_system_html. Again in this case
87 :     /webwork_system_html is prefered.
88 :    
89 :     See the html document
90 :     webwork/system/system_html/docs/techdescription/settingupsystem.html for
91 :     detailed explanations. The examples here are taken from those directions.
92 :    
93 :     };
94 :    
95 :     my $MODE_TEXT = q{
96 :    
97 :     You can set up a "working" or a "demo" WeBWorK system. A "demo" system
98 :     should only be used as a sample system, never for a system that will be used
99 :     with actual courses with real students. The main difference between a
100 :     "working" version and a "demo" version is that in a "working" version you
101 :     will be promped to enter a group (e.g. wwadmin) where as in a "demo"
102 :     version, the group will be set yo your own default group (e.g. fac). Anyone
103 :     in the group will have permission to modify all webwork files. You can set
104 :     up "working" and "demo" courses under either a "working" or a "demo" system,
105 :     but normally you would not set up a "working" course under a "demo" system.
106 :    
107 :     };
108 :    
109 : gage 6 my $MAIN_DIR_TEXT = q{
110 : sam 2
111 : gage 6 The directory containing the WeBWorK system files (as well as this
112 :     script) is known as the main directory. In order to modify system files,
113 :     I need to know where the main directory for this installation is. If you
114 :     invoked this script as ./system_webwork_setup.pl, then you are already
115 :     in the main directory and can accept the default.
116 : sam 2
117 :     };
118 :    
119 :     my $PERL_TEXT = q{
120 :    
121 :     WeBWorK needs to know the path of your perl binary, so that this information
122 :     can be used in the headers of cgi scripts. If you were able to run this
123 :     script by typing "./system_webwork_setup.pl", the path to a perl binary is
124 :     listed on the first line of this script.
125 :    
126 :     };
127 :    
128 :     my $CGI_URL_TEXT = q{
129 :    
130 :     In order for generated HTML to be able to invoke CGI scripts, WeBWorK needs
131 :     to know the URL which points to the main WeBWorK system cgi subdirectory.
132 :     For example, http://www.math.rochester.edu.edu/cgi-bin/webwork/system might
133 :     be a valid CGI URL. If both static HTML and CGIs reside on the same host
134 :     (which is true in most cases), you can omit the
135 :     http://www.math.rochester.edu section of the URL. Make sure to include a
136 :     leading slash in this case.
137 :    
138 :     };
139 :    
140 :     my $HTML_URL_TEXT = q{
141 :    
142 :     WeBWorK also needs to know the URL of the main HTML directory, the system
143 :     html subdirectory. For example,
144 :     http://www.math.rochester.edu/webwork_system_html or /webwork_system_html.
145 :    
146 :     };
147 :    
148 :     my $GROUP_TEXT = q{
149 :    
150 :     WeBWorK needs to know what the admin group is. This group should have been
151 :     set up by your system administrator and must contain at least your user ID.
152 :     All files and directories created will have this as their group.
153 :    
154 :     };
155 :    
156 :     my $COURSE_PERMS_TEXT = q{
157 :    
158 :     You have the option to set permissions for the courses directory. If this is
159 :     an inital setup, you should probably do so. If this is not an initial setup,
160 :     the courses directory is already set up, or the courses directory is shared
161 :     between WeBWorK installations, your probably shouldn't.
162 :    
163 :     };
164 :    
165 :     my $CHGRP_TEXT = q{
166 :    
167 :     You have to option to set the group for all system files and directories. If
168 :     this is an initial setup, you should probably do this. If this is not an
169 :     initial setup, or you have customized the way system files should be
170 :     grouped, you probably shoudn't.
171 :    
172 :     };
173 :    
174 :     my $CHMOD_TEXT = q{
175 :    
176 :     You have to option to set the permissions for all system files and
177 :     directories. If this is an initial setup, you should probably do this. If
178 :     this is not an initial setup, or you have customized the permissions for the
179 :     system files, you probably shoudn't.
180 :    
181 :     };
182 :    
183 :     my $CONFIRM_TEXT = q{
184 :    
185 :     Now that I have the necessary information, I can begin modifying the WeBWorK
186 :     system files.
187 :    
188 :     };
189 :    
190 :     my $DONE_TEXT = q{
191 :    
192 :     The system setup script is done. Your WeBWorK system directory is now set up
193 :     correctly.
194 :    
195 :     };
196 :    
197 :    
198 :    
199 :    
200 :    
201 :     ################################################################################
202 :     ########## Ask some questions, perform some logic. #############################
203 :     ################################################################################
204 :    
205 :    
206 :    
207 :    
208 :    
209 :     #################### introduction
210 :    
211 :     my $temp;
212 :    
213 :     unless($no_prompts) {
214 :     page($INTRO_TEXT);
215 :     $temp = questionChar("Do you want to continue with setup?", 'y', 'y', 'n');
216 :     exit unless $temp eq 'y';
217 :     }
218 :     print "Okay, here we go...\n";
219 :    
220 :     #################### working or demo?
221 :    
222 :     unless(defined $system_setup_mode) {
223 :     page($MODE_TEXT);
224 :     $temp = questionChar("Shall we set up a working version or a demo version?", 'w', 'w', 'd');
225 :     $system_setup_mode = "working" if $temp eq 'w';
226 :     $system_setup_mode = "demo" if $temp eq 'd';
227 :     }
228 :     print "System setup mode is: $system_setup_mode\n";
229 :    
230 :     #################### main directory
231 :    
232 : gage 6 unless(defined $mainDir) {
233 :     page($MAIN_DIR_TEXT);
234 :     $mainDir = questionString("Where is the main WeBWorK directory?", cwd());
235 : sam 2 $mainDir .= '/' unless $mainDir =~ m|/$|; # ensure trailing slash
236 :     }
237 : gage 6 print "We'll use $mainDir as WeBWorK's home.\n";
238 : sam 2
239 :     #################### perl path
240 :    
241 :     unless(defined $perlPath) {
242 :     page($PERL_TEXT);
243 :     $perlPath = questionString("What is the full path to PERL?", $DEFAULT_PERL_PATH);
244 :     }
245 :     print "Path to PERL binary is: $perlPath\n";
246 :    
247 :     #################### CGI URL
248 :    
249 :     unless(defined $cgiURL) {
250 :     page($CGI_URL_TEXT);
251 :     while (1) {
252 :     $cgiURL = questionString("What is the CGI URL?", $DEFAULT_CGI_URL);
253 :     if( ($cgiURL =~ m|^/|) or ($cgiURL =~ m|^http://|) ) {
254 :     last;
255 :     } else {
256 :     $temp = questionChar("That doesn't look like a valid URL. Would you like to use it anyway?", 'n', 'y', 'n');
257 :     last if $temp eq 'y';
258 :     }
259 :     }
260 :     $cgiURL .= "/" unless $cgiURL =~ m"/$"; # ensure trailing slash
261 :     }
262 :     print "CGI URL is: $cgiURL\n";
263 :    
264 :     #################### HTML URL
265 :    
266 :     unless(defined $htmlURL) {
267 :     page($HTML_URL_TEXT);
268 :     while (1) {
269 :     $htmlURL = questionString("What is the HTML URL?", $DEFAULT_HTML_URL);
270 :     if( ($htmlURL =~ m|^/|) or ($htmlURL =~ m|^http://|) ) {
271 :     last;
272 :     } else {
273 :     $temp = questionChar("That doesn't look like a valid URL. Would you like to use it anyway?", 'n', 'y', 'n');
274 :     last if $temp eq 'y';
275 :     }
276 :     }
277 :     $htmlURL .= "/" unless $htmlURL =~ m"/$" ;
278 :     }
279 :     print "HTML URL is: $htmlURL\n";
280 :    
281 :     #################### admin group
282 :    
283 :     unless(defined $groupName) {
284 :     my ($userName, $userGID) = (getpwuid $<)[0,3];
285 :     my $userGroupName = (getgrgid $userGID)[0];
286 :    
287 :     if ($system_setup_mode eq 'demo') {
288 :     # in demo mode, the group is set to the user's primary group
289 :     $groupName = $userGroupName;
290 :     } else {
291 :     # in working mode, we get to chose
292 :     page($GROUP_TEXT);
293 :     my $validGroup = 0;
294 :     while(1) {
295 :     $groupName = questionString("What is the admin group name?", $userGroupName);
296 :     my @members = split / /, (getgrnam $groupName)[3];
297 :     if($groupName eq $userGroupName) {
298 :     print "$groupName is $userName's primary group. Good.\n";
299 :     } elsif(grep /$userName/, @members) {
300 :     print "$userName is a member of $groupName. Good.\n";
301 :     last;
302 :     } elsif($< == 0) { # we're root!
303 :     print "$userName isn't a member of $groupName, but you're root, so who cares?\n";
304 :     last;
305 :     } else {
306 :     print "That group is not valid. Please make sure the group exists and you are a member.\n";
307 :     }
308 :     }
309 :     }
310 :     }
311 :     print "Admin group is: $groupName\n";
312 :    
313 :     #################### chmod courses directory
314 :    
315 :     unless(defined $update_stuff_in_courses) {
316 :     page($COURSE_PERMS_TEXT);
317 :     $temp = questionChar("Do you want to set default $system_setup_mode permissions for the courses directory?", 'y', 'y', 'n');
318 :     $update_stuff_in_courses = ($temp eq 'y');
319 :     }
320 :     print "Permissions ", ($update_stuff_in_courses ? "will" : "will not"), " be set for the courses directory.\n";
321 :    
322 :    
323 :     #################### chgrp files/directories
324 :    
325 :     $system_setup_mode eq "demo" and $chgrp_files_and_dirs = 1;
326 :     unless(defined $chgrp_files_and_dirs) {
327 :     page($CHGRP_TEXT);
328 :     $temp = questionChar("Do you want to set the group for system files and directories?", 'y', 'y', 'n');
329 :     $chgrp_files_and_dirs = ($temp eq 'y');
330 :     }
331 :     print "Group ", ($chgrp_files_and_dirs ? "will" : "will not"), " be set for system files and directories.\n";
332 :    
333 :     #################### chmod files/directories
334 :    
335 :     $system_setup_mode eq "demo" and $chmod_files_and_dirs = 1;
336 :     unless(defined $chmod_files_and_dirs) {
337 :     page($CHMOD_TEXT);
338 :     $temp = questionChar("Do you want to set the permissions for system files and directories?", 'y', 'y', 'n');
339 :     $chmod_files_and_dirs = ($temp eq 'y');
340 :     }
341 :     print "Permissions ", ($chmod_files_and_dirs ? "will" : "will not"), " be set for system files and directories.\n";
342 :    
343 :     #################### make sure we want to actually do this
344 :    
345 :     unless($no_prompts) {
346 :     print $CONFIRM_TEXT;
347 :     $temp = questionChar("Do you want to continue with setup?", 'y', 'y', 'n');
348 :     exit unless $temp eq 'y';
349 :     }
350 :     print "\Going to make changes now...\n\n";
351 :    
352 :    
353 :    
354 :    
355 :    
356 :     ################################################################################
357 :     ########## Now we start changing things... #####################################
358 :     ################################################################################
359 :    
360 :    
361 :    
362 :    
363 :    
364 :     #################### run local preprocessor
365 :    
366 :     if(defined $local_preprocessor) {
367 :     print "Executing local preprocessor...\n";
368 :     &$local_preprocessor;
369 :     print "Done with local preprocessor.\n";
370 :     }
371 :    
372 :     #################### update Global.pm
373 : gage 6 #needs: $mainDir, $cgiURL, $htmlURL
374 : sam 2
375 : gage 8 #chdir "lib";
376 :     #
377 :     #-e 'Global.pm' or die "Global.pm doesn't exist! There's no point in continuing.\n";
378 :     #if(-e 'Global.pm.bak1') {
379 :     # print "Copying Global.pm.bak1 -> Global.pm.bak2\n";
380 :     # copy('Global.pm.bak1', 'Global.pm.bak2');
381 :     #}
382 :     #print "Copying Global.pm -> Global.pm.bak1\n";
383 :     #copy('Global.pm', 'Global.pm.bak1');
384 :     #
385 :     #open OLD_GLOBAL, "Global.pm.bak1";
386 :     #open NEW_GLOBAL, ">Global.pm";
387 :     #
388 :     #while (<OLD_GLOBAL>) {
389 :     # if (/^\$mainDirectory/) {
390 :     # print NEW_GLOBAL "\$mainDirectory = '$mainDir';\n";
391 :     # print "\$mainDirectory = '$mainDir';\n";
392 :     # } elsif (/\#$CGI_DEBUG_TAG$/) {
393 :     # print NEW_GLOBAL "\#\$cgiWebworkURL = '$cgiURL'; \#$CGI_DEBUG_TAG\n";
394 :     # print "\#\$cgiWebworkURL = '$cgiURL'; \#$CGI_DEBUG_TAG\n";
395 :     # } elsif (/\#$CGI_NODEBUG_TAG$/) {
396 :     # print NEW_GLOBAL "\$cgiWebworkURL = '${cgiURL}cgi-scripts/'; \#$CGI_NODEBUG_TAG\n";
397 :     # print "\$cgiWebworkURL = '${cgiURL}cgi-scripts/'; \#$CGI_NODEBUG_TAG\n";
398 :     # } elsif (/^\$htmlWebworkURL/) {
399 :     # print NEW_GLOBAL "\$htmlWebworkURL = '$htmlURL';\n";
400 :     # print "\$htmlWebworkURL = '$htmlURL';\n";
401 :     # } else {
402 :     # print NEW_GLOBAL $_;
403 :     # }
404 :     #}
405 :     #
406 :     #close NEW_GLOGAL;
407 :     #close OLD_GLOBAL;
408 :     #
409 :     #chmod(0644, "Global.pm");
410 :     #chdir "..";
411 :     #print "Done updating Global.pm\n\n";
412 : sam 2
413 :     #################### update couses stuff
414 :     # uses: $update_stuff_in_courses
415 :    
416 :     if($update_stuff_in_courses) {
417 :     print "Setting permissions for ../courses directory.\n\n";
418 :     chmod(0755, '../courses') or warn "Warning: I can't set permissions for ../courses directory. It's possible that the directory doesn't exist or you don't have permission to change it.\n";
419 :     }
420 :    
421 :     #################### update #! and use lines
422 : gage 6 # uses: $mainDir, $perlPath
423 : sam 2 # i must fix this some day
424 :    
425 :     print "Fixing #! and \"use\" lines...\n";
426 :    
427 : gage 8 my $USE_LINE = "use lib '.'; use webworkInit; \# $LIB_INIT_LINE_TAG\n";
428 : sam 2
429 :     # fix up the *.pl files
430 :     foreach my $dir ('cgi/cgi-scripts', 'scripts', 'courseScripts') {
431 :     foreach my $file (<${dir}/*.pl>) {
432 :     fixFile($file, $USE_LINE);
433 :     }
434 :     }
435 :    
436 :     # fix up the course_webwork_setup.pl file and some modules.
437 :     my @files = ('lib/PGtranslator.pm', 'lib/Auth.pm', 'lib/capa2PG.pm');
438 :     push @files,'../courses/demoCourse/course_webwork_setup.pl' if $update_stuff_in_courses;
439 :     foreach my $file (@files) {
440 :     if($file eq 'lib/PGtranslator.pm') { fixFile($file, $USE_LINE); }
441 :     else { fixFile($file); }
442 :     }
443 :    
444 :     sub fixFile
445 :     {
446 :     my ($file, $use_line) = @_;
447 :    
448 :     # read the file
449 : gage 6 open FILE, $file || die "CAN'T READ $file!\n Fix the problem and run the setup script again";
450 : sam 2 my @lines = <FILE>;
451 : gage 6 close FILE || die "CAN'T CLOSE $file!\n Fix the problem and run the setup script again";
452 : sam 2
453 :     # fix perl path
454 :     my $num = 0;
455 :     $num = $lines[0] =~ s/^#!.*/#!$perlPath/g; # fix #!... line
456 :     warn "couldn't fix #! line in $file\n" unless $num;
457 :    
458 : gage 8 # # fix use lines
459 :     # if($use_line) {
460 :     # $num = 0;
461 :     # foreach (@lines) {
462 :     # if (/^.*\#\s*\Q$MAIN_DIR_TAG\E.*$/) {
463 :     # $num++;
464 :     # $_ = $use_line;
465 :     # }
466 :     # }
467 :     # warn "fixed $num 'use lib' lines in $file\n" if $num > 1;
468 :     # }
469 : sam 2
470 :     # write the file
471 :     open FILE, ">$file" || die "CAN'T WRITE $file!\n Fix the problem and run the setup script again";
472 :     print FILE @lines;
473 : gage 6 close FILE || die "CAN'T CLOSE (writing) $file!\n Fix the problem and run the setup script again";
474 : sam 2 }
475 :    
476 :     print "done fixing #! and \"use\" lines.\n\n";
477 :    
478 : gage 8 #################### create webworkInit.pm files
479 :     # uses: $mainDir
480 :    
481 :     foreach my $dir ('cgi/cgi-scripts/', 'scripts/') {
482 :     open INIT_FILE, ">$mainDir${dir}webworkInit.pm";
483 :     print INIT_FILE "use lib '${mainDir}lib/';\n1;\n";
484 :     close INIT_FILE;
485 :     }
486 :    
487 : sam 2 #################### chgrp system stuff
488 :     # uses: $chgrp_files_and_dirs, $groupName
489 :    
490 :     if($chgrp_files_and_dirs) {
491 :     print "Setting group on system files and directories...\n";
492 :     # R=recursive, P=don't follow symlinks
493 :     system "chgrp -PR $groupName .";
494 :     print "Done setting group.\n\n";
495 :     }
496 :    
497 :     #################### chmod system stuff
498 :     # uses: $chmod_files_and_dirs
499 :    
500 :     if($chmod_files_and_dirs) {
501 :     print "Setting permissions on system files and directories for $system_setup_mode mode...\n";
502 :     if ($system_setup_mode eq "demo") {
503 :     # get some general permissions for files and directories
504 :     system "find . -type d -print0 | xargs -0 chmod 0711";
505 :     system "find . -type f -print0 | xargs -0 chmod 0644";
506 :     # add executable privs to scripts
507 : gage 6 system "find cgi scripts -type f -print0 | xargs -0 chmod 0755";
508 : sam 2 # give everyone write access to logs
509 :     # (we should probably just be chowning the log directory to the webserver)
510 : gage 6 system "chmod 0666 logs/*";
511 : sam 2 # make this script executable and safe
512 : gage 6 system "chmod 0700 system_webwork_setup.pl"
513 : sam 2 } else {
514 :     # get some general permissions for files and directories
515 :     system "find . -type d -print0 | xargs -0 chmod 0771";
516 :     system "find . -type f -print0 | xargs -0 chmod 0664";
517 :     # add executable privs to scripts
518 : gage 6 system "find cgi scripts -type f -print0 | xargs -0 chmod 0775";
519 : sam 2 # give everyone write access to logs
520 :     # (we should probably just be chowning the log directory to the webserver)
521 : gage 6 system "chmod 0666 logs/*";
522 : sam 2 # make this script executable and safe
523 : gage 6 system "chmod 0770 system_webwork_setup.pl"
524 : sam 2 }
525 :     print "done setting permissions.\n\n";
526 :     }
527 :    
528 :     #################### fix up the documemtation html files
529 :     # uses: $htmlURL, $cgiURL
530 :    
531 :     print "Fixing image, cgi-bin, and ref lines in documentation html files...\n";
532 :     foreach my $dir ('system_html/helpFiles') {
533 :     foreach my $file (<${dir}/*.html>) {
534 :     open FILE, $file || die "CAN'T READ $file!\n Fix the problem and run the setup script again";
535 :     my @lines = <FILE>;
536 :     close FILE || die "CAN'T CLOSE $file!\n Fix the problem and run the setup script again";
537 :    
538 :     foreach my $line (@lines) {
539 :     $line =~ s|<IMG SRC=".*?images/|<IMG SRC="${htmlURL}images/|g; # fix "images" line
540 :     $line =~ s|<A HREF=".*?feedback.pl">|<A HREF="${cgiURL}feedback.pl">|g; # fix "cgi-bin" line
541 :     $line =~ s|<A HREF=".*?docs/">|<A HREF="${htmlURL}docs/">|g; # fix "Ref" line
542 :     }
543 :     open FILE, ">$file" || die "CAN'T WRITE $file!\n Fix the problem and run the setup script again";
544 :     print FILE @lines;
545 :     close FILE || die "CAN'T CLOSE (writing) $file!\n Fix the problem and run the setup script again";
546 :     }
547 :     }
548 :     print "done fixing documentation files.\n\n";
549 :    
550 :     #################### run local postprocessor
551 :    
552 :     if(defined $local_postprocessor) {
553 :     print "Executing local preprocessor...\n";
554 :     &$local_postprocessor;
555 :     print "Done with local preprocessor.\n";
556 :     }
557 :    
558 :     #################### finish up
559 :    
560 :     page($DONE_TEXT);
561 :    
562 :     ################################################################################
563 :    
564 :     sub page
565 :     {
566 :     my @string_lines = split /^/, shift; #/
567 :     # not really optimal, but we're going to assume a constant screen height.
568 :     my $SCREEN_HEIGHT = 20;
569 :     while(@string_lines) {
570 :     print join "", @string_lines[0..$SCREEN_HEIGHT-1];
571 :     if(scalar @string_lines >= $SCREEN_HEIGHT) {
572 :     print "\n[Press ENTER to continues...]";
573 :     <STDIN>;
574 :     print "\n";
575 :     }
576 :     @string_lines = @string_lines[$SCREEN_HEIGHT..$#string_lines];
577 :     }
578 :     }
579 :    
580 :     sub questionChar
581 :     {
582 :     my ($question, $default, @valid) = @_;
583 :     my $answer;
584 :     do {
585 :     print $question, " ";
586 :     foreach (@valid) {
587 :     $_ eq $default and print "[";
588 :     print $_;
589 :     $_ eq $default and print "]";
590 :     }
591 :     print " ";
592 :     $answer = <STDIN>;
593 :     $answer =~ s/^\s*//;
594 :     $answer = substr $answer, 0, 1;
595 :     $answer = lc $answer;
596 :     $answer or $answer = $default;
597 :     } while (not grep(/$answer/, @valid));
598 :     return $answer;
599 :     }
600 :    
601 :     sub questionString
602 :     {
603 :     my ($question, $default, $emptyOK) = @_;
604 :     my $answer;
605 :     print $question, " [", $default, "] ";
606 :     $answer = <STDIN>;
607 :     chomp $answer;
608 :     $answer =~ s/^\s*//;
609 :     $answer or $answer = $default;
610 :     return $answer;
611 :     }

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9