moving non koha-running files to misc dir
[wip/koha-chris_n.git] / safe-installer
1 #!/usr/bin/perl -w
2
3 # $Id$
4
5 # Copyright 2002 Katipo Communications
6 #
7 # This file is part of Koha.
8 #
9 # Koha is free software; you can redistribute it and/or modify it under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
12 # version.
13 #
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License along with
19 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
20 # Suite 330, Boston, MA  02111-1307 USA
21
22 use strict;
23
24 use vars qw( $answer $missing $status );
25 use vars '@CLEANUP';    # A stack of references-to-code. When this script
26                         # exits, whether normally or abnormally, each
27                         # bit of cleanup code is run to clean up. See
28                         # also &cleanup, below.
29 use vars '%CACHE';      # Cached values from the previous run, used to
30                         # supply defaults when the user runs the installer
31                         # a second time.
32 use vars '%PROG';       # This hash maps internal names for programs to
33                         # their full pathnames, e.g.
34                         # $PROG{"perl"} eq "/usr/local/bin/perl"
35 use vars '@PROG_DEF';   # This contains declarations saying which external
36                         # programs the installer needs to find.
37 use vars qw($KOHA_CONF);
38                         # Location of koha.conf file
39 use vars qw(%PERL_MODULES);
40                         # Installed perl modules. Actually, these are
41                         # only the optional modules, since the
42                         # installer dies if it can't find one or more
43                         # required modules.
44 use vars qw($DB_NAME $DB_HOST $DB_USER $DB_PASSWD);
45                         # Database name, host, user, and password for
46                         # accessing the Koha database.
47 use vars qw($MYSQL_ADMIN $MYSQL_PASSWD);
48                         # MySQL administrator name and password. Used
49                         # to create the database and give the Koha
50                         # user privileges on the Koha database.
51 use vars qw($USE_VHOSTS);
52                         # True iff we'll be using virtual hosts
53 use vars qw($OPAC_HOST @OPAC_REALHOSTS $INTRA_HOST @INTRA_REALHOSTS);
54                         # Web hosts: $OPAC_HOST and $INTRA_HOST are
55                         # the (virtual) hosts on which the OPAC and
56                         # intranet reside.
57                         # @OPAC_REALHOSTS and @INTRA_REALHOSTS list
58                         # the real hosts on which the $OPAC_HOST and
59                         # $INTRA_HOST (virtual) hosts reside. They are
60                         # arrays because the user might spread the
61                         # load among several real hosts.
62
63 $SIG{'__DIE__'} = \&sig_DIE;    # Clean up after we die
64 $SIG{'INT'} = \&sig_INT;        # Clean up if ^C given
65
66 $| = 1;                         # Flush output immediately, in case the
67                                 # user is piping this script or something.
68
69 # XXX - Log everything that happens
70
71 ### Phase 1: Gather information
72
73 # Warn the installer about potential nastiness, and give ver a chance
74 # to abort now.
75 $answer = &y_or_n(<<EOT, 1);
76                    WARNING WARNING WARNING WARNING
77
78 This is an unstable version of Koha, blah blah blah unhappiness
79 blah blah nuclear war blah blah spouse will leave you blah blah
80
81 Are you sure you want to continue?
82 EOT
83 if (!$answer)
84 {
85         exit 0;
86 }
87
88 # XXX - Make sure we're in the right directory. Look for a few
89 # required files ("koha.mysql" seems like a good candidate). If they
90 # don't exist, try 'cd `dirname $0`' and try again.
91
92 # See if there's a cache file, and load it if the user'll allow us
93 if ( -f "installer.cache" )
94 {
95         $answer = &y_or_n(<<EOT, 1);
96 There appears to be a cache file left over from a previous
97 run of $0. Do you wish to reuse this information?
98 EOT
99         &load_cache if $answer;
100 }
101
102 # Figure out a default location for koha.conf. First, try the location
103 # specified in the previous run, then the value of the $KOHA_CONF
104 # environment variable (hey, it might be set), and finally
105 # /etc/koha.conf.
106 $KOHA_CONF =    $CACHE{"koha_conf"} ||
107                 $ENV{"KOHA_CONF"} ||
108                 "/etc/koha.conf";
109 $CACHE{"koha_conf"} = $KOHA_CONF;
110
111 # If there's a /etc/koha.conf, ask whether the user wants installer to
112 # read it for hints.
113 if ( -r $KOHA_CONF)
114 {
115         $answer = &y_or_n(<<EOT, defined($CACHE{"hints_from_old_koha_conf"}) ? $CACHE{"hints_from_old_koha_conf"} : 1);
116
117 You already have a $KOHA_CONF file.
118 Shall I read it to get hints as to where to install Koha?
119 EOT
120         $CACHE{"hints_from_old_koha_conf"} = $answer;
121         if ($answer)
122         {
123                 my $old_koha_conf;
124
125                 $old_koha_conf = &read_koha_conf($CACHE{"koha_conf"});
126                                 # Read the existing config file
127
128                 # Slurp the old config values into %CACHE, with a
129                 # "conf_" prefix.
130                 while (my ($key, $value) = each %{$old_koha_conf})
131                 {
132                         $CACHE{"conf_$key"} = $value;
133                 }
134         }
135         # XXX - Ask whether the user wants a backup of the existing
136         # database.
137 }
138 delete $CACHE{"conf_pass"};     # Don't cache any passwords
139
140 print "\n* Looking for common programs.\n\n";
141
142 # Define the list of external programs we need to find
143 @PROG_DEF = (
144         # The bit on the left is the program as we'll refer to it
145         # internally, usually something like $PROG{"perl"}. On the
146         # right is the list of names under which it might be
147         # installed.
148         [ "stty"        => "stty" ],
149         [ "chown"       => "chown" ],
150         [ "chmod"       => "chmod" ],
151         [ "perl"        => "perl", "perl5" ],
152         [ "install"     => "ginstall", "install" ],
153         [ "make"        => "gmake", "make" ],
154         [ "mysql"       => "mysql" ],
155         [ "mysqladmin"  => "mysqladmin" ],
156         [ "mysqldump"   => "mysqldump" ],
157 );
158
159 # First, we try to find the programs automatically on the user's
160 # $PATH. Later, we'll give ver a chance to override any and all of
161 # these paths, but presumably the automatic search will be correct
162 # 90+% of the time, so this reduces erosion on the user's <return>
163 # key.
164 foreach my $prog_def (@PROG_DEF)
165 {
166         my $prog = shift @{$prog_def};
167         my $fullpath;           # Full path to program
168
169         next if !defined($prog);
170
171         printf "%-20s: ", $prog;
172         $fullpath = $CACHE{"prog_$prog"} || &find_program(@{$prog_def});
173         if (!defined($fullpath))
174         {
175                 # Can't find this program
176                 $missing = 1;
177                 print "** Not found\n";
178                 next;
179         }
180
181         $CACHE{"prog_$prog"} =
182         $PROG{$prog}         = $fullpath;
183         print $fullpath, "\n";
184 }
185
186 if ($missing)
187 {
188         # One or more programs were not found. We've already printed
189         # an error message about this above.
190         print <<EOT;
191
192 WARNING:
193 Some programs could not be found. 
194
195 EOT
196 } else {
197         # Ask the user 
198         $answer = &y_or_n("Does this look okay?", 1);
199         $missing = 1 if !$answer;
200 }
201
202 if ($missing)
203 {
204         # Either some program could not be found, or else the user
205         # didn't like the paths. Either way, go through the list and
206         # ask.
207         foreach my $prog_def (@PROG_DEF)
208         {
209                 my $prog = shift @{$prog_def};
210                 my $fullpath;           # Full path to program
211
212                 $fullpath = &ask(<<EOT, $PROG{$prog});
213 Please enter the full pathname to $prog:
214 EOT
215                 $CACHE{"prog_$prog"} = $fullpath;
216         }
217 }
218
219 # Check for required Perl modules
220 # XXX - Perhaps should cache $PERL5LIB as well
221 print "\nChecking for required Perl modules.\n";
222 $missing = 0;
223
224 # DBI
225 printf "%-20s: ", "DBI...";
226 if (eval { require DBI; })
227 {
228         print "Found\n";
229 } else {
230         print "Not found\n";
231         $missing = 1;
232 }
233
234 # DBD::mysql
235 printf "%-20s: ", "DBD::mysql...";
236 if (eval { require DBD::mysql; })
237 {
238         print "Found\n";
239 } else {
240         print "Not found\n";
241         $missing = 1;
242 }
243
244 # Date::Manip
245 printf "%-20s: ", "Date::Manip...";
246 if (eval { require Date::Manip; })
247 {
248         print "Found\n";
249 } else {
250         print "Not found\n";
251         $missing = 1;
252 }
253
254 if ($missing)
255 {
256         print <<EOT;
257
258 One or more required Perl modules appear to be missing. Please install
259 them, then run $0 again.
260
261 EOT
262         exit 1;
263 }
264
265 print "\nChecking for optional Perl modules.\n";
266 $missing = 0;
267
268 # Net::Z3950
269 printf "%-20s: ", "Net::Z3950...";
270 if (eval { require Net::Z3950; })
271 {
272         print "Found\n";
273         $PERL_MODULES{"Net::Z3950"} = 1;
274 } else {
275         print "Not found\n";
276         $missing = 1;
277 }
278
279 if ($missing)
280 {
281         print <<EOT;
282
283 One or more optional Perl modules appear to be missing. Koha may still
284 be installed, but some optional features may not be enabled.
285
286 EOT
287         $answer = &y_or_n(<<EOT, 0);
288 Do you wish to abort the installation?
289 EOT
290 }
291
292 print "\n* Configuring database\n";
293
294 # Get the database administrator's name
295 $MYSQL_ADMIN = &ask(<<EOT, $CACHE{"dba_user"});
296
297 Please enter the MySQL database administrator's name:
298 EOT
299 #'
300 $CACHE{"dba_user"} = $MYSQL_ADMIN;
301
302 # Get the database administrator's password
303 # This is NOT cached
304 push @CLEANUP, sub { system $PROG{"stty"}, "echo"; };
305                         # Restore screen echo if we get interrupted
306 system $PROG{"stty"}, "-echo";          # Turn off screen echo
307 $MYSQL_PASSWD = &ask(<<EOT, "");
308
309 Please enter the MySQL database administrator's password. This will
310 not be written to any file, and is optional. If you leave this blank,
311 you will be prompted for it every time it is needed, in the
312 installation phase.
313
314 Database administrator password:
315 EOT
316 #'
317 system $PROG{"stty"}, "echo";           # Turn screen echo back on
318 print "\n";             # The user's \n, which wasn't displayed
319
320 # Get the database name
321 $DB_NAME = &ask(<<EOT, $CACHE{"db_name"} || $CACHE{"conf_database"});
322
323 Please enter the name of the Koha database:
324 EOT
325 $CACHE{"db_name"} = $DB_NAME;
326
327 # Get database host
328 $DB_HOST = &ask(<<EOT, $CACHE{"db_host"} || $CACHE{"conf_hostname"});
329
330 Please enter the hostname or IP address of the host on which the
331 database should be installed:
332 EOT
333 $CACHE{"db_host"} = $DB_HOST;
334
335 # Get the name of the Koha (database) user
336 $DB_USER = &ask(<<EOT, $CACHE{"db_user"} || $CACHE{"conf_user"});
337 Please enter the name of the Koha user:
338 EOT
339 $CACHE{"db_user"} = $DB_USER;
340
341 # Get the Koha database password
342 # The Koha password is not cached, since the installer cache file is
343 # world-readable (unless the user has an unusually restrictive umask,
344 # but we can't assume that).
345
346 # XXX - Actually, we might need up to three passwords: one for the
347 # intranet, one for the OPAC, and one for the database server. Or
348 # perhaps we need two or three Koha users; the point is to minimize
349 # the amount of damage that can be wrought if someone breaks in to a
350 # web or database server.
351 #
352 # The OPAC Koha user should be allowed to read anything, and update a
353 # few limited tables, like session IDs and suchlike, but should on no
354 # account be permitted to modify the catalogue.
355 #
356 # The intranet Koha user should have permission to read everything and
357 # write all sorts of things, including the catalogue, but should not
358 # be allowed to drop tables or do anything destructive to the database
359 # itself.
360 #
361 # The maintenance user should be allowed to do everything. Then again,
362 # perhaps the maintenance user can be installed manually by a clueful
363 # DBA.
364 system $PROG{"stty"}, "-echo";          # Turn off screen echo
365 $DB_PASSWD = &ask(<<EOT, $CACHE{"conf_pass"});
366 Please enter the Koha user's password:
367 EOT
368 #'
369 system $PROG{"stty"}, "echo";           # Turn screen echo back on
370 print "\n";             # The user's \n, which wasn't displayed
371
372 # XXX - Ask whether to install sample data. Default to no, especially
373 # if the user requested a backup, earlier.
374
375 # XXX - Ask whether to restore the database from a backup. Should take
376 # a glob pattern, and read each file in turn. Should default to the
377 # backup we made earlier.
378
379 print "\n* Web site configuration.\n";
380
381 # XXX - Get information about how to set up the web servers.
382 # Specifically:
383 #       - Will you be using virtual hosts?
384 #       - OPAC virtual host name?
385 #       - OPAC real host name?
386 #               Need to grant read-only authorization to Koha user
387 #               from the real OPAC host. Perhaps have different
388 #               passwords for intranet and OPAC access.
389 #       - Intranet virtual host name?
390 #       - Intranet real host name?
391 #               Need to grant all access to Koha user from the real
392 #               intranet host. Perhaps have different passwords for
393 #               intranet and OPAC access.
394 #       - Is the database server also running a web server?
395 #               If so, then need to grant OPAC or intranet access to
396 #               the database from "localhost".
397 # XXX - Try to guess this from $CACHE{conf_*}
398
399 # XXX - Ask whether one machine will be both the only OPAC server and
400 # the only intranet server. If yes, then a) we need to use virtual
401 # hosts (for now), and b) we probably want to use the same koha.conf
402 # file for both.
403
404 $USE_VHOSTS = &y_or_n(<<EOT, $CACHE{"use_vhosts"} || 1);
405
406 Will you be using virtual hosts for either the OPAC or intranet
407 site?
408 EOT
409 $CACHE{"use_vhosts"} = $USE_VHOSTS;
410
411 $OPAC_HOST = &ask(<<EOT, $CACHE{"opac_host"});
412
413 What is the externally-visible name of the host on which the OPAC web
414 site will reside?
415 EOT
416 $CACHE{"opac_host"} = $OPAC_HOST;
417
418 if ($USE_VHOSTS)
419 {
420         # XXX - Prompt for list of real hosts
421         @OPAC_REALHOSTS = ($OPAC_HOST); # XXX - Just temporary
422 } else {
423         @OPAC_REALHOSTS = ($OPAC_HOST);
424 }
425 $CACHE{"opac_realhosts"} = join(" ", @OPAC_REALHOSTS);
426
427 #$INSTALL_OPAC = &y_or_n("Do you wish to install the OPAC web site?", 1);
428 ## XXX - Gather OPAC information
429 #$INSTALL_INTRANET = &y_or_n("Do you wish to install the intranet web site?",
430 #       1);
431 ## XXX - Gather intranet information
432
433 # XXX - Get apache.conf file
434
435 # XXX - Find out where to install
436 #       - OPAC HTML files
437 #       - OPAC cgi-bin files
438 #       - Intranet HTML files
439 #       - Intranet cgi-bin files
440 # XXX - Try to guess this from $CACHE{conf_*}
441
442 # XXX - Get the user and group that should own these files. Try to
443 # guess this from the "User" and "Group" lines in apache.conf. If the
444 # user is found but the group isn't, use getgr*() and use the first
445 # group found there. In any case, ask the user to confirm.
446
447 # XXX - Get root URLs:
448 #       - OPAC HTML
449 #       - OPAC cgi-bin
450 #       - Intranet HTML
451 #       - Intranet cgi-bin
452 # XXX - Try to guess this from $CACHE{conf_*}
453
454 &save_cache;                    # Write the cache file for future use
455
456 ### XXX - Phase 2: Generate config files
457
458 # XXX - Generate sample apache.conf section for OPAC and internal
459 # virtual hosts.
460
461 # Generate the configuration file that will be used by 'make'
462 &write_conf("Make.conf", undef,
463         "db_passwd"     => $DB_PASSWD
464         );
465
466 # Generate koha.conf
467 # XXX - Ask whether to use the same koha.conf file for the intranet
468 # and OPAC sites.
469 &write_conf("koha.conf.new", "koha.conf.in",
470         "db_passwd"     => $DB_PASSWD
471         );
472
473 ### XXX - Phase 3: Install files
474
475 # XXX - Warn the user that the installation will reveal the DBA and
476 # Koha user's passwords (briefly) in the output of 'ps'. That for
477 # greater security, he should do things manually.
478 # XXX - Also perhaps set $ENV{MYSQL_PWD}
479
480 # XXX - Actually, this should just use 'make <whatever>' to do stuff.
481
482 # XXX - In each case, give user a chance to edit the file first.
483
484 # XXX - Make sure to convert #! line before installing any scripts
485
486 # XXX - When overwriting files, make sure to keep a backup
487
488 # XXX - Installing/upgrading database:
489 # - Get MySQL admin username and password
490 # - Get database hostname
491 # - See if the database exists already. If not, create it.
492 # - See if koha user has rights on the database. If not, add them.
493
494 # XXX - 'make install-db', if requested
495
496 $answer = &y_or_n(<<EOT, 1);
497
498 Would you like to create the Koha database now?
499 EOT
500 if ($answer)
501 {
502         $status = system $PROG{"make"}, "install-db";
503         if ($status != 0)
504         {
505                 print <<EOT;
506
507 *** Error
508 The database installation appears to have failed. Please read any
509 error messages that may have been reported above, correct them, and
510 try again.
511
512 EOT
513                 if (&y_or_n(<<EOT, 1))
514 Do you wish to abort the installation?
515 EOT
516                 {
517                         print "Exiting.\n";
518                         &cleanup;
519                         exit 1;
520                 }
521         }
522 } else {
523         print <<EOT;
524
525 When you are ready, you can install the database by running
526         make install-db
527 EOT
528 }
529
530 &cleanup;                       # Clean up before exiting
531
532 ########################################
533 # Utility functions
534
535 # readfile
536 # Read the contents of a file and return them. This is basically
537 # /bin/cat.
538 # In a scalar context, returns a string with the contents of the file.
539 # In array context, returns an array containing the chomp()ed strings
540 # comprising the file.
541 #
542 # Thus, if you just want to read the chomp()ed first line of a file,
543 # you can
544 #       ($line) = &readfile("/my/file");
545 sub readfile
546 {
547         my $fname = shift;
548         my @lines;
549
550         open F, "< $fname" or die "Can't open $fname: $!";
551         @lines = <F>;           # Slurp in the whole file
552         close F;
553
554         if (defined(wantarray) && wantarray)
555         {
556                 # Array context. Return a list of lines
557                 for (@lines)
558                 {
559                         chomp;
560                 }
561                 return @lines;
562         }
563
564         # Void or scalar context. Return the concatenation of the
565         # lines.
566         return join("", @lines);
567 }
568
569 # load_cache
570 # Read the cache file, and store cached values in %CACHE.
571 # The format of the cache file is:
572 #       <variable><space><value>
573 # Note: there is only one space between the variable and its value.
574 # This allows us to have values with whitespace in them.
575 #
576 # Blank lines are ignored. Any line that begins with "#" is a comment.
577 # The value may contain escape sequences of the form "\xAB", where
578 # "AB" is a pair of hex digits representing the ASCII value of the
579 # real character.
580 sub load_cache
581 {
582         open CACHE, "< installer.cache" or do {
583                 warn "Can't open cache file :$!";
584                 return;
585                 };
586         while (<CACHE>)
587         {
588                 my $var;
589                 my $value;
590
591                 chomp;
592                 next if /^\#/;          # Ignore comments
593                 next if /^\s*$/;        # Ignore blank lines
594
595                 if (!/^(\w+)\s(.*)/)
596                 {
597                         warn "Bad line in cache file, line $.:\n$_\n";
598                 }
599                 $var = $1;
600                 $value = $2;
601
602                 # Unescape special characters
603                 $value =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge;
604
605                 $CACHE{$var} = $value;
606         }
607         close CACHE;
608 }
609
610 # _sanitize
611 # Utility function used by &save_cache: escapes suspicious-looking
612 # characters in a string, and returns the cleaned-up string.
613 sub _sanitize
614 {
615         my $string = shift;
616
617         $string =~ s{[^-\+\w\d \t.;/\{\}\@]}{sprintf("\\x%02x", ord($&))}ge;
618         return $string;
619 }
620
621 # save_cache
622 # Save cacheable values to the cache file
623 sub save_cache
624 {
625         my $var;                # Variable name
626         my $value;              # Variable value
627
628         open CACHE, "> installer.cache" or do {
629                 warn "Can't write to cache file: $!";
630                 return;
631                 };
632         # Write the keys.
633         while (($var, $value) = each %CACHE)
634         {
635                 print CACHE "$var\t", &_sanitize($value), "\n";
636         }
637         close CACHE;
638 }
639
640 # find_program
641 # Find a program in $ENV{PATH}. Each argument is a variant name of the
642 # program to look for. That is,
643 #       &find_program("bison", "yacc");
644 # will first look for "bison", and if that's not found, will look for
645 # "yacc".
646 # Returns the full pathname if found, or undef otherwise. If the
647 # program appears in multiple path directories, returns the first one.
648 sub find_program
649 {
650         my @path = split /:/, $ENV{"PATH"};
651
652         # The $prog loop is on the outside: if the caller calls
653         # &find_program("bison", "yacc"), that means that the caller
654         # would prefer to find "bison", but will settle for "yacc".
655         # Hence, we want to look for "bison" first.
656         foreach my $prog (@_)
657         {
658                 foreach my $dir (@path)
659                 {
660                         # Make sure that what we've found is not only
661                         # executable, but also a plain file
662                         # (directories are also executable, you know).
663                         if ( -f "$dir/$prog" && -x "$dir/$prog")
664                         {
665                                 return "$dir/$prog";
666                         }
667                 }
668         }
669         return undef;           # Didn't find it
670 }
671
672 # ask
673 # Ask the user a question, and return the result.
674 # If $default is undef, &ask will keep asking the question until it
675 # gets a nonempty answer.
676 # If $default is the empty string and the user just hits <return>,
677 # &ask will return the empty string.
678 # The remaining arguments, if any, are the list of acceptable answers.
679 # &ask will keep asking the question until it gets one of the
680 # acceptable answers. If the list is empty, any answer will do.
681 # NOTE: the list of acceptable answers is not displayed to the user.
682 # You need to make them part of the question.
683 sub ask
684 {
685         my $question = shift;   # The question to ask
686         my $default  = shift;   # The return value if the user just hits
687                                 # <return>
688         my @answers  = @_;      # The list of acceptable responses
689         my $answer;             # The user's answer
690
691         # Prettify whitespace at the end of the question. First, we
692         # remove the trailing newline that will have been left by
693         # <<EOT. Then we add a blank if there isn't any whitespace at
694         # the end of the question, simply because it looks prettier
695         # that way.
696         chomp $question;
697         $question .= " " unless $question =~ /\s$/;
698
699         while (1)
700         {
701                 # Print the question and the default answer, if any
702                 print $question;
703                 if (defined($default) && $default ne "")
704                 {
705                         print "[$default] ";
706                 }
707
708                 # Read the answer
709                 $answer = <STDIN>;
710                 die "EOF on STDIN" if !defined($answer);
711                 $answer =~ s/^\s+//gs;  # Trim whitespace
712                 $answer =~ s/\s+//gs;
713
714                 if ($answer eq "")
715                 {
716                         # The user just hit <return>. See if that's okay
717                         if (!defined($default))
718                         {
719                                 print "Sorry, you must give an answer.\n\n";
720                                 redo;
721                         }
722
723                         # There's a default. Use it.
724                         $answer = $default;
725                         last;
726                 } else {
727                         # The user gave an answer. See if it's okay.
728
729                         # If the caller didn't specify a list of
730                         # acceptable answers, then all answers are
731                         # okay.
732                         last if $#answers < 0;
733
734                         # Make sure the answer is on the list
735                         for (@answers)
736                         {
737                                 last if $answer eq $_;
738                         }
739
740                         print "Sorry, I don't understand that answer.\n\n";
741                 }
742         }
743         return $answer;
744 }
745
746 # y_or_n
747 # Asks a yes-or-no question. If the user answers yes, returns true,
748 # otherwise returns false.
749 # The second argument, $default, is a boolean value. If not given, it
750 # defaults to true.
751 sub y_or_n
752 {
753         my $question = shift;   # The question to ask
754         my $default  = shift;   # Default answer
755         my $def_prompt;         # The "(Y/n)" thingy at the end.
756         my $answer;
757
758         $default = 1 unless defined($default);  # True by default
759
760         chomp $question;
761         $question .= " " unless $question =~ /\s$/s;
762         if ($default)
763         {
764                 $question .= "(Y/n)";
765         } else {
766                 $question .= "(y/N)";
767         }
768
769         # Keep asking the question until we get an answer
770         while (1)
771         {
772                 $answer = &ask($question, "");
773
774                 return $default if $answer eq "";
775
776                 if ($answer =~ /^y(es)?$/i)
777                 {
778                         return 1;
779                 } elsif ($answer =~ /^no?$/) {
780                         return 0;
781                 }
782
783                 print "Please answer yes or no.\n\n";
784         }
785 }
786
787 # read_koha_conf
788 # Reads the specified Koha config file. Returns a reference-to-hash
789 # whose keys are the configuration variables, and whose values are the
790 # configuration values (duh).
791 # Returns undef in case of error.
792 #
793 # Stolen from C4/Context.pm, but I'd like this script to be standalone.
794 sub read_koha_conf
795 {
796         my $fname = shift;      # Config file to read
797         my $retval = {};        # Return value: ref-to-hash holding the
798                                 # configuration
799
800         open (CONF, $fname) or return undef;
801
802         while (<CONF>)
803         {
804                 my $var;                # Variable name
805                 my $value;              # Variable value
806
807                 chomp;
808                 s/#.*//;                # Strip comments
809                 next if /^\s*$/;        # Ignore blank lines
810
811                 # Look for a line of the form
812                 #       var = value
813                 if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/)
814                 {
815                         # FIXME - Complain about bogus line
816                         next;
817                 }
818
819                 # Found a variable assignment
820                 # FIXME - Ought to complain is this line sets a
821                 # variable that was already set.
822                 $var = $1;
823                 $value = $2;
824                 $retval->{$var} = $value;
825         }
826         close CONF;
827
828         return $retval;
829 }
830
831 # write_conf
832 # Very similar to what autoconf does with Makefile.in --> Makefile. So
833 # similar, in fact, that it should be trivial to make this work with
834 # autoconf.
835 #
836 # &write_conf takes a file name and an optional template file, and
837 # generates the file by replacing all sequences of the form "@var@" in
838 # the template with $CACHE{var}.
839 #
840 # If the template file name is omitted, it defaults to the output
841 # file, with ".in" appended.
842 sub write_conf
843 {
844         my $fname = shift;              # Output file name
845         my $template = shift;           # Template file name
846         my %extras = @_;                # Additional key=>value pairs
847
848         push @CLEANUP, sub { unlink $fname };
849                         # If we're interrupted while writing the
850                         # output file, don't leave a partial one lying
851                         # around
852         # Generate template file name
853         $template = $fname . ".in" unless defined $template;
854
855         # Generate the output file
856         open TMPL, "< $template" or die "Can't open $template: $!";
857         open OUT, "> $fname" or die "Can't write to $fname: $!";
858         chmod 0600, $fname;             # Restrictive permissions
859         while (<TMPL>)
860         {
861                 # Replace strings of the form "@var@" with the
862                 # variable's value. Look first in %extras, then in
863                 # %CACHE. Use the first one that's defined. If none of
864                 # them are, use the empty string.
865                 # We can't use
866                 #       $extras{$1} || $CACHE{$1}
867                 # because "0" is a perfectly good substitution value,
868                 # but would evaluate as false. And we need the empty
869                 # string because if neither one is defined, the "perl
870                 # -w" option would complain about us using an
871                 # undefined value.
872                 s{\@(\w+)\@}
873                  {
874                         if (defined($extras{$1}))
875                         {
876                                 $extras{$1};
877                         } elsif (defined($CACHE{$1}))
878                         {
879                                 $CACHE{$1};
880                         } else {
881                                 "";
882                         }
883                  }ge;
884                 print OUT;
885         }
886         close OUT;
887         close TMPL;
888
889         pop @CLEANUP;
890 }
891
892 # cleanup
893 # Clean up after the script when it dies. Pops each bit of cleanup
894 # code from @CLEANUP in turn and executes it. This way, the cleanup
895 # functions are called in the reverse of the order in which they were
896 # added.
897 sub cleanup
898 {
899         my $code;
900
901         while ($code = pop @CLEANUP)
902         {
903                 eval &$code;
904         }
905 }
906
907 # sig_DIE
908 # This is the $SIG{__DIE__} handler. It gets called when the script
909 # exits abnormally. It calls &cleanup to remove any temporary files
910 # and whatnot that may have been created.
911 sub sig_DIE
912 {
913         my $msg = shift;        # die() message. Not currently used
914
915         return if !defined($^S);        # Don't die before parsing is done
916         return if $^S;                  # Don't clean up if dying inside
917                                         # an eval
918
919         &cleanup();
920
921         print STDERR "\n", $msg;
922         die <<EOT;
923
924 *** FAILURE ***
925
926         The installer has failed. Please check any error messages that
927 may have been printed above, correct the problem(s), and try again.
928
929 EOT
930 }
931
932 # sig_INT
933 # SIGINT handler. Clean up and exit if the user cancels with ^C.
934 sub sig_INT
935 {
936         &cleanup();
937
938         print STDERR <<EOT;
939
940 *** CANCELLED ***
941
942         Configuration cancelled.
943
944 EOT
945
946         exit 1;
947 }