Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 947 lines (801 sloc) 25.173 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947
#!/usr/bin/perl -w

# $Id$

# Copyright 2002 Katipo Communications
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA

use strict;

use vars qw( $answer $missing $status );
use vars '@CLEANUP'; # A stack of references-to-code. When this script
# exits, whether normally or abnormally, each
# bit of cleanup code is run to clean up. See
# also &cleanup, below.
use vars '%CACHE'; # Cached values from the previous run, used to
# supply defaults when the user runs the installer
# a second time.
use vars '%PROG'; # This hash maps internal names for programs to
# their full pathnames, e.g.
# $PROG{"perl"} eq "/usr/local/bin/perl"
use vars '@PROG_DEF'; # This contains declarations saying which external
# programs the installer needs to find.
use vars qw($KOHA_CONF);
# Location of koha.conf file
use vars qw(%PERL_MODULES);
# Installed perl modules. Actually, these are
# only the optional modules, since the
# installer dies if it can't find one or more
# required modules.
use vars qw($DB_NAME $DB_HOST $DB_USER $DB_PASSWD);
# Database name, host, user, and password for
# accessing the Koha database.
use vars qw($MYSQL_ADMIN $MYSQL_PASSWD);
# MySQL administrator name and password. Used
# to create the database and give the Koha
# user privileges on the Koha database.
use vars qw($USE_VHOSTS);
# True iff we'll be using virtual hosts
use vars qw($OPAC_HOST @OPAC_REALHOSTS $INTRA_HOST @INTRA_REALHOSTS);
# Web hosts: $OPAC_HOST and $INTRA_HOST are
# the (virtual) hosts on which the OPAC and
# intranet reside.
# @OPAC_REALHOSTS and @INTRA_REALHOSTS list
# the real hosts on which the $OPAC_HOST and
# $INTRA_HOST (virtual) hosts reside. They are
# arrays because the user might spread the
# load among several real hosts.

$SIG{'__DIE__'} = \&sig_DIE; # Clean up after we die
$SIG{'INT'} = \&sig_INT; # Clean up if ^C given

$| = 1; # Flush output immediately, in case the
# user is piping this script or something.

# XXX - Log everything that happens

### Phase 1: Gather information

# Warn the installer about potential nastiness, and give ver a chance
# to abort now.
$answer = &y_or_n(<<EOT, 1);
WARNING WARNING WARNING WARNING

This is an unstable version of Koha, blah blah blah unhappiness
blah blah nuclear war blah blah spouse will leave you blah blah

Are you sure you want to continue?
EOT
if (!$answer)
{
exit 0;
}

# XXX - Make sure we're in the right directory. Look for a few
# required files ("koha.mysql" seems like a good candidate). If they
# don't exist, try 'cd `dirname $0`' and try again.

# See if there's a cache file, and load it if the user'll allow us
if ( -f "installer.cache" )
{
$answer = &y_or_n(<<EOT, 1);
There appears to be a cache file left over from a previous
run of $0. Do you wish to reuse this information?
EOT
&load_cache if $answer;
}

# Figure out a default location for koha.conf. First, try the location
# specified in the previous run, then the value of the $KOHA_CONF
# environment variable (hey, it might be set), and finally
# /etc/koha.conf.
$KOHA_CONF = $CACHE{"koha_conf"} ||
$ENV{"KOHA_CONF"} ||
"/etc/koha.conf";
$CACHE{"koha_conf"} = $KOHA_CONF;

# If there's a /etc/koha.conf, ask whether the user wants installer to
# read it for hints.
if ( -r $KOHA_CONF)
{
$answer = &y_or_n(<<EOT, defined($CACHE{"hints_from_old_koha_conf"}) ? $CACHE{"hints_from_old_koha_conf"} : 1);

You already have a $KOHA_CONF file.
Shall I read it to get hints as to where to install Koha?
EOT
$CACHE{"hints_from_old_koha_conf"} = $answer;
if ($answer)
{
my $old_koha_conf;

$old_koha_conf = &read_koha_conf($CACHE{"koha_conf"});
# Read the existing config file

# Slurp the old config values into %CACHE, with a
# "conf_" prefix.
while (my ($key, $value) = each %{$old_koha_conf})
{
$CACHE{"conf_$key"} = $value;
}
}
# XXX - Ask whether the user wants a backup of the existing
# database.
}
delete $CACHE{"conf_pass"}; # Don't cache any passwords

print "\n* Looking for common programs.\n\n";

# Define the list of external programs we need to find
@PROG_DEF = (
# The bit on the left is the program as we'll refer to it
# internally, usually something like $PROG{"perl"}. On the
# right is the list of names under which it might be
# installed.
[ "stty" => "stty" ],
[ "chown" => "chown" ],
[ "chmod" => "chmod" ],
[ "perl" => "perl", "perl5" ],
[ "install" => "ginstall", "install" ],
[ "make" => "gmake", "make" ],
[ "mysql" => "mysql" ],
[ "mysqladmin" => "mysqladmin" ],
[ "mysqldump" => "mysqldump" ],
);

# First, we try to find the programs automatically on the user's
# $PATH. Later, we'll give ver a chance to override any and all of
# these paths, but presumably the automatic search will be correct
# 90+% of the time, so this reduces erosion on the user's <return>
# key.
foreach my $prog_def (@PROG_DEF)
{
my $prog = shift @{$prog_def};
my $fullpath; # Full path to program

next if !defined($prog);

printf "%-20s: ", $prog;
$fullpath = $CACHE{"prog_$prog"} || &find_program(@{$prog_def});
if (!defined($fullpath))
{
# Can't find this program
$missing = 1;
print "** Not found\n";
next;
}

$CACHE{"prog_$prog"} =
$PROG{$prog} = $fullpath;
print $fullpath, "\n";
}

if ($missing)
{
# One or more programs were not found. We've already printed
# an error message about this above.
print <<EOT;

WARNING:
Some programs could not be found.

EOT
} else {
# Ask the user
$answer = &y_or_n("Does this look okay?", 1);
$missing = 1 if !$answer;
}

if ($missing)
{
# Either some program could not be found, or else the user
# didn't like the paths. Either way, go through the list and
# ask.
foreach my $prog_def (@PROG_DEF)
{
my $prog = shift @{$prog_def};
my $fullpath; # Full path to program

$fullpath = &ask(<<EOT, $PROG{$prog});
Please enter the full pathname to $prog:
EOT
$CACHE{"prog_$prog"} = $fullpath;
}
}

# Check for required Perl modules
# XXX - Perhaps should cache $PERL5LIB as well
print "\nChecking for required Perl modules.\n";
$missing = 0;

# DBI
printf "%-20s: ", "DBI...";
if (eval { require DBI; })
{
print "Found\n";
} else {
print "Not found\n";
$missing = 1;
}

# DBD::mysql
printf "%-20s: ", "DBD::mysql...";
if (eval { require DBD::mysql; })
{
print "Found\n";
} else {
print "Not found\n";
$missing = 1;
}

# Date::Manip
printf "%-20s: ", "Date::Manip...";
if (eval { require Date::Manip; })
{
print "Found\n";
} else {
print "Not found\n";
$missing = 1;
}

if ($missing)
{
print <<EOT;

One or more required Perl modules appear to be missing. Please install
them, then run $0 again.

EOT
exit 1;
}

print "\nChecking for optional Perl modules.\n";
$missing = 0;

# Net::Z3950
printf "%-20s: ", "Net::Z3950...";
if (eval { require Net::Z3950; })
{
print "Found\n";
$PERL_MODULES{"Net::Z3950"} = 1;
} else {
print "Not found\n";
$missing = 1;
}

if ($missing)
{
print <<EOT;

One or more optional Perl modules appear to be missing. Koha may still
be installed, but some optional features may not be enabled.

EOT
$answer = &y_or_n(<<EOT, 0);
Do you wish to abort the installation?
EOT
}

print "\n* Configuring database\n";

# Get the database administrator's name
$MYSQL_ADMIN = &ask(<<EOT, $CACHE{"dba_user"});

Please enter the MySQL database administrator's name:
EOT
#'
$CACHE{"dba_user"} = $MYSQL_ADMIN;

# Get the database administrator's password
# This is NOT cached
push @CLEANUP, sub { system $PROG{"stty"}, "echo"; };
# Restore screen echo if we get interrupted
system $PROG{"stty"}, "-echo"; # Turn off screen echo
$MYSQL_PASSWD = &ask(<<EOT, "");

Please enter the MySQL database administrator's password. This will
not be written to any file, and is optional. If you leave this blank,
you will be prompted for it every time it is needed, in the
installation phase.

Database administrator password:
EOT
#'
system $PROG{"stty"}, "echo"; # Turn screen echo back on
print "\n"; # The user's \n, which wasn't displayed

# Get the database name
$DB_NAME = &ask(<<EOT, $CACHE{"db_name"} || $CACHE{"conf_database"});

Please enter the name of the Koha database:
EOT
$CACHE{"db_name"} = $DB_NAME;

# Get database host
$DB_HOST = &ask(<<EOT, $CACHE{"db_host"} || $CACHE{"conf_hostname"});

Please enter the hostname or IP address of the host on which the
database should be installed:
EOT
$CACHE{"db_host"} = $DB_HOST;

# Get the name of the Koha (database) user
$DB_USER = &ask(<<EOT, $CACHE{"db_user"} || $CACHE{"conf_user"});
Please enter the name of the Koha user:
EOT
$CACHE{"db_user"} = $DB_USER;

# Get the Koha database password
# The Koha password is not cached, since the installer cache file is
# world-readable (unless the user has an unusually restrictive umask,
# but we can't assume that).

# XXX - Actually, we might need up to three passwords: one for the
# intranet, one for the OPAC, and one for the database server. Or
# perhaps we need two or three Koha users; the point is to minimize
# the amount of damage that can be wrought if someone breaks in to a
# web or database server.
#
# The OPAC Koha user should be allowed to read anything, and update a
# few limited tables, like session IDs and suchlike, but should on no
# account be permitted to modify the catalogue.
#
# The intranet Koha user should have permission to read everything and
# write all sorts of things, including the catalogue, but should not
# be allowed to drop tables or do anything destructive to the database
# itself.
#
# The maintenance user should be allowed to do everything. Then again,
# perhaps the maintenance user can be installed manually by a clueful
# DBA.
system $PROG{"stty"}, "-echo"; # Turn off screen echo
$DB_PASSWD = &ask(<<EOT, $CACHE{"conf_pass"});
Please enter the Koha user's password:
EOT
#'
system $PROG{"stty"}, "echo"; # Turn screen echo back on
print "\n"; # The user's \n, which wasn't displayed

# XXX - Ask whether to install sample data. Default to no, especially
# if the user requested a backup, earlier.

# XXX - Ask whether to restore the database from a backup. Should take
# a glob pattern, and read each file in turn. Should default to the
# backup we made earlier.

print "\n* Web site configuration.\n";

# XXX - Get information about how to set up the web servers.
# Specifically:
# - Will you be using virtual hosts?
# - OPAC virtual host name?
# - OPAC real host name?
# Need to grant read-only authorization to Koha user
# from the real OPAC host. Perhaps have different
# passwords for intranet and OPAC access.
# - Intranet virtual host name?
# - Intranet real host name?
# Need to grant all access to Koha user from the real
# intranet host. Perhaps have different passwords for
# intranet and OPAC access.
# - Is the database server also running a web server?
# If so, then need to grant OPAC or intranet access to
# the database from "localhost".
# XXX - Try to guess this from $CACHE{conf_*}

# XXX - Ask whether one machine will be both the only OPAC server and
# the only intranet server. If yes, then a) we need to use virtual
# hosts (for now), and b) we probably want to use the same koha.conf
# file for both.

$USE_VHOSTS = &y_or_n(<<EOT, $CACHE{"use_vhosts"} || 1);

Will you be using virtual hosts for either the OPAC or intranet
site?
EOT
$CACHE{"use_vhosts"} = $USE_VHOSTS;

$OPAC_HOST = &ask(<<EOT, $CACHE{"opac_host"});

What is the externally-visible name of the host on which the OPAC web
site will reside?
EOT
$CACHE{"opac_host"} = $OPAC_HOST;

if ($USE_VHOSTS)
{
# XXX - Prompt for list of real hosts
@OPAC_REALHOSTS = ($OPAC_HOST); # XXX - Just temporary
} else {
@OPAC_REALHOSTS = ($OPAC_HOST);
}
$CACHE{"opac_realhosts"} = join(" ", @OPAC_REALHOSTS);

#$INSTALL_OPAC = &y_or_n("Do you wish to install the OPAC web site?", 1);
## XXX - Gather OPAC information
#$INSTALL_INTRANET = &y_or_n("Do you wish to install the intranet web site?",
# 1);
## XXX - Gather intranet information

# XXX - Get apache.conf file

# XXX - Find out where to install
# - OPAC HTML files
# - OPAC cgi-bin files
# - Intranet HTML files
# - Intranet cgi-bin files
# XXX - Try to guess this from $CACHE{conf_*}

# XXX - Get the user and group that should own these files. Try to
# guess this from the "User" and "Group" lines in apache.conf. If the
# user is found but the group isn't, use getgr*() and use the first
# group found there. In any case, ask the user to confirm.

# XXX - Get root URLs:
# - OPAC HTML
# - OPAC cgi-bin
# - Intranet HTML
# - Intranet cgi-bin
# XXX - Try to guess this from $CACHE{conf_*}

&save_cache; # Write the cache file for future use

### XXX - Phase 2: Generate config files

# XXX - Generate sample apache.conf section for OPAC and internal
# virtual hosts.

# Generate the configuration file that will be used by 'make'
&write_conf("Make.conf", undef,
"db_passwd" => $DB_PASSWD
);

# Generate koha.conf
# XXX - Ask whether to use the same koha.conf file for the intranet
# and OPAC sites.
&write_conf("koha.conf.new", "koha.conf.in",
"db_passwd" => $DB_PASSWD
);

### XXX - Phase 3: Install files

# XXX - Warn the user that the installation will reveal the DBA and
# Koha user's passwords (briefly) in the output of 'ps'. That for
# greater security, he should do things manually.
# XXX - Also perhaps set $ENV{MYSQL_PWD}

# XXX - Actually, this should just use 'make <whatever>' to do stuff.

# XXX - In each case, give user a chance to edit the file first.

# XXX - Make sure to convert #! line before installing any scripts

# XXX - When overwriting files, make sure to keep a backup

# XXX - Installing/upgrading database:
# - Get MySQL admin username and password
# - Get database hostname
# - See if the database exists already. If not, create it.
# - See if koha user has rights on the database. If not, add them.

# XXX - 'make install-db', if requested

$answer = &y_or_n(<<EOT, 1);

Would you like to create the Koha database now?
EOT
if ($answer)
{
$status = system $PROG{"make"}, "install-db";
if ($status != 0)
{
print <<EOT;

*** Error
The database installation appears to have failed. Please read any
error messages that may have been reported above, correct them, and
try again.

EOT
if (&y_or_n(<<EOT, 1))
Do you wish to abort the installation?
EOT
{
print "Exiting.\n";
&cleanup;
exit 1;
}
}
} else {
print <<EOT;

When you are ready, you can install the database by running
make install-db
EOT
}

&cleanup; # Clean up before exiting

########################################
# Utility functions

# readfile
# Read the contents of a file and return them. This is basically
# /bin/cat.
# In a scalar context, returns a string with the contents of the file.
# In array context, returns an array containing the chomp()ed strings
# comprising the file.
#
# Thus, if you just want to read the chomp()ed first line of a file,
# you can
# ($line) = &readfile("/my/file");
sub readfile
{
my $fname = shift;
my @lines;

open F, "< $fname" or die "Can't open $fname: $!";
@lines = <F>; # Slurp in the whole file
close F;

if (defined(wantarray) && wantarray)
{
# Array context. Return a list of lines
for (@lines)
{
chomp;
}
return @lines;
}

# Void or scalar context. Return the concatenation of the
# lines.
return join("", @lines);
}

# load_cache
# Read the cache file, and store cached values in %CACHE.
# The format of the cache file is:
# <variable><space><value>
# Note: there is only one space between the variable and its value.
# This allows us to have values with whitespace in them.
#
# Blank lines are ignored. Any line that begins with "#" is a comment.
# The value may contain escape sequences of the form "\xAB", where
# "AB" is a pair of hex digits representing the ASCII value of the
# real character.
sub load_cache
{
open CACHE, "< installer.cache" or do {
warn "Can't open cache file :$!";
return;
};
while (<CACHE>)
{
my $var;
my $value;

chomp;
next if /^\#/; # Ignore comments
next if /^\s*$/; # Ignore blank lines

if (!/^(\w+)\s(.*)/)
{
warn "Bad line in cache file, line $.:\n$_\n";
}
$var = $1;
$value = $2;

# Unescape special characters
$value =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge;

$CACHE{$var} = $value;
}
close CACHE;
}

# _sanitize
# Utility function used by &save_cache: escapes suspicious-looking
# characters in a string, and returns the cleaned-up string.
sub _sanitize
{
my $string = shift;

$string =~ s{[^-\+\w\d \t.;/\{\}\@]}{sprintf("\\x%02x", ord($&))}ge;
return $string;
}

# save_cache
# Save cacheable values to the cache file
sub save_cache
{
my $var; # Variable name
my $value; # Variable value

open CACHE, "> installer.cache" or do {
warn "Can't write to cache file: $!";
return;
};
# Write the keys.
while (($var, $value) = each %CACHE)
{
print CACHE "$var\t", &_sanitize($value), "\n";
}
close CACHE;
}

# find_program
# Find a program in $ENV{PATH}. Each argument is a variant name of the
# program to look for. That is,
# &find_program("bison", "yacc");
# will first look for "bison", and if that's not found, will look for
# "yacc".
# Returns the full pathname if found, or undef otherwise. If the
# program appears in multiple path directories, returns the first one.
sub find_program
{
my @path = split /:/, $ENV{"PATH"};

# The $prog loop is on the outside: if the caller calls
# &find_program("bison", "yacc"), that means that the caller
# would prefer to find "bison", but will settle for "yacc".
# Hence, we want to look for "bison" first.
foreach my $prog (@_)
{
foreach my $dir (@path)
{
# Make sure that what we've found is not only
# executable, but also a plain file
# (directories are also executable, you know).
if ( -f "$dir/$prog" && -x "$dir/$prog")
{
return "$dir/$prog";
}
}
}
return undef; # Didn't find it
}

# ask
# Ask the user a question, and return the result.
# If $default is undef, &ask will keep asking the question until it
# gets a nonempty answer.
# If $default is the empty string and the user just hits <return>,
# &ask will return the empty string.
# The remaining arguments, if any, are the list of acceptable answers.
# &ask will keep asking the question until it gets one of the
# acceptable answers. If the list is empty, any answer will do.
# NOTE: the list of acceptable answers is not displayed to the user.
# You need to make them part of the question.
sub ask
{
my $question = shift; # The question to ask
my $default = shift; # The return value if the user just hits
# <return>
my @answers = @_; # The list of acceptable responses
my $answer; # The user's answer

# Prettify whitespace at the end of the question. First, we
# remove the trailing newline that will have been left by
# <<EOT. Then we add a blank if there isn't any whitespace at
# the end of the question, simply because it looks prettier
# that way.
chomp $question;
$question .= " " unless $question =~ /\s$/;

while (1)
{
# Print the question and the default answer, if any
print $question;
if (defined($default) && $default ne "")
{
print "[$default] ";
}

# Read the answer
$answer = <STDIN>;
die "EOF on STDIN" if !defined($answer);
$answer =~ s/^\s+//gs; # Trim whitespace
$answer =~ s/\s+//gs;

if ($answer eq "")
{
# The user just hit <return>. See if that's okay
if (!defined($default))
{
print "Sorry, you must give an answer.\n\n";
redo;
}

# There's a default. Use it.
$answer = $default;
last;
} else {
# The user gave an answer. See if it's okay.

# If the caller didn't specify a list of
# acceptable answers, then all answers are
# okay.
last if $#answers < 0;

# Make sure the answer is on the list
for (@answers)
{
last if $answer eq $_;
}

print "Sorry, I don't understand that answer.\n\n";
}
}
return $answer;
}

# y_or_n
# Asks a yes-or-no question. If the user answers yes, returns true,
# otherwise returns false.
# The second argument, $default, is a boolean value. If not given, it
# defaults to true.
sub y_or_n
{
my $question = shift; # The question to ask
my $default = shift; # Default answer
my $def_prompt; # The "(Y/n)" thingy at the end.
my $answer;

$default = 1 unless defined($default); # True by default

chomp $question;
$question .= " " unless $question =~ /\s$/s;
if ($default)
{
$question .= "(Y/n)";
} else {
$question .= "(y/N)";
}

# Keep asking the question until we get an answer
while (1)
{
$answer = &ask($question, "");

return $default if $answer eq "";

if ($answer =~ /^y(es)?$/i)
{
return 1;
} elsif ($answer =~ /^no?$/) {
return 0;
}

print "Please answer yes or no.\n\n";
}
}

# read_koha_conf
# Reads the specified Koha config file. Returns a reference-to-hash
# whose keys are the configuration variables, and whose values are the
# configuration values (duh).
# Returns undef in case of error.
#
# Stolen from C4/Context.pm, but I'd like this script to be standalone.
sub read_koha_conf
{
my $fname = shift; # Config file to read
my $retval = {}; # Return value: ref-to-hash holding the
# configuration

open (CONF, $fname) or return undef;

while (<CONF>)
{
my $var; # Variable name
my $value; # Variable value

chomp;
s/#.*//; # Strip comments
next if /^\s*$/; # Ignore blank lines

# Look for a line of the form
# var = value
if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/)
{
# FIXME - Complain about bogus line
next;
}

# Found a variable assignment
# FIXME - Ought to complain is this line sets a
# variable that was already set.
$var = $1;
$value = $2;
$retval->{$var} = $value;
}
close CONF;

return $retval;
}

# write_conf
# Very similar to what autoconf does with Makefile.in --> Makefile. So
# similar, in fact, that it should be trivial to make this work with
# autoconf.
#
# &write_conf takes a file name and an optional template file, and
# generates the file by replacing all sequences of the form "@var@" in
# the template with $CACHE{var}.
#
# If the template file name is omitted, it defaults to the output
# file, with ".in" appended.
sub write_conf
{
my $fname = shift; # Output file name
my $template = shift; # Template file name
my %extras = @_; # Additional key=>value pairs

push @CLEANUP, sub { unlink $fname };
# If we're interrupted while writing the
# output file, don't leave a partial one lying
# around
# Generate template file name
$template = $fname . ".in" unless defined $template;

# Generate the output file
open TMPL, "< $template" or die "Can't open $template: $!";
open OUT, "> $fname" or die "Can't write to $fname: $!";
chmod 0600, $fname; # Restrictive permissions
while (<TMPL>)
{
# Replace strings of the form "@var@" with the
# variable's value. Look first in %extras, then in
# %CACHE. Use the first one that's defined. If none of
# them are, use the empty string.
# We can't use
# $extras{$1} || $CACHE{$1}
# because "0" is a perfectly good substitution value,
# but would evaluate as false. And we need the empty
# string because if neither one is defined, the "perl
# -w" option would complain about us using an
# undefined value.
s{\@(\w+)\@}
{
if (defined($extras{$1}))
{
$extras{$1};
} elsif (defined($CACHE{$1}))
{
$CACHE{$1};
} else {
"";
}
}ge;
print OUT;
}
close OUT;
close TMPL;

pop @CLEANUP;
}

# cleanup
# Clean up after the script when it dies. Pops each bit of cleanup
# code from @CLEANUP in turn and executes it. This way, the cleanup
# functions are called in the reverse of the order in which they were
# added.
sub cleanup
{
my $code;

while ($code = pop @CLEANUP)
{
eval &$code;
}
}

# sig_DIE
# This is the $SIG{__DIE__} handler. It gets called when the script
# exits abnormally. It calls &cleanup to remove any temporary files
# and whatnot that may have been created.
sub sig_DIE
{
my $msg = shift; # die() message. Not currently used

return if !defined($^S); # Don't die before parsing is done
return if $^S; # Don't clean up if dying inside
# an eval

&cleanup();

print STDERR "\n", $msg;
die <<EOT;

*** FAILURE ***

The installer has failed. Please check any error messages that
may have been printed above, correct the problem(s), and try again.

EOT
}

# sig_INT
# SIGINT handler. Clean up and exit if the user cancels with ^C.
sub sig_INT
{
&cleanup();

print STDERR <<EOT;

*** CANCELLED ***

Configuration cancelled.

EOT

exit 1;
}
Something went wrong with that request. Please try again.