[Koha-cvs] CVS: koha/misc safe-installer,NONE,1.1

Paul POULAIN tipaul at users.sourceforge.net
Mon Nov 25 17:37:12 CET 2002


Update of /cvsroot/koha/koha/misc
In directory sc8-pr-cvs1:/tmp/cvs-serv6138

Added Files:
	safe-installer 
Log Message:
rebirthing safe-installer.
Note that buildrelease is broken for instance, so don't expect any installer to work well.
buildrelease will be corrected asap.

--- NEW FILE ---
#!/usr/bin/perl -w

# $Id: safe-installer,v 1.1 2002/11/25 16:37:09 tipaul Exp $

# 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;
}






More information about the Koha-cvs mailing list