947 lines
25 KiB
Perl
Executable file
947 lines
25 KiB
Perl
Executable file
#!/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;
|
|
}
|