You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

2246 lines
67 KiB

#!/usr/bin/perl -w
# Script to handle building KDE from CVS. All of the configuration is stored
# in the file ~/.kdecvs-buildrc.
#
# Please also see the documentation that should be included with this program,
# in doc.html
#
# This script is designed to be run by cron, which will
# collect the output and mail it to the user who requested
# the job. For that reason, all script output is sent to STDOUT. The
# commands are logged, however, for easy perusal later.
#
# Copyright (c) 2003, 2004 Michael Pyne. <pynm0001@comcast.net>
# Home page: http://grammarian.homelinux.net/kdecvs-build/
#
# You may use, alter, and redistribute this software under the terms
# of the GNU General Public License, v2 (or any later version).
#
# XXX: It would be better to have lockfiles in each directory as it's
# being updated, instead of having one big lock for the script.
use strict;
use warnings;
use Fcntl; # For sysopen constants
use POSIX qw(strftime);
# Some global variables
# Remember kids, global variables are evil! I only get to do this
# because I'm an adult and you're not! :-P
# Options that start with a # will replace values with the same name,
# if the option is actually set.
my %global_opts = (
"apply-qt-patches" => "",
"binpath" => "",
"build-dir" => "build",
"build-system-only" => "",
"checkout-only" => "",
"configure-flags" => "",
"cvs-root" => "$ENV{HOME}/kdecvs",
"cvs-server" => "",
"cxxflags" => "",
"debug" => "",
"do-not-compile" => "",
"set-env" => { }, # Hash of environment vars to set
"install-after-build" => "1", # Default to true
"inst-apps" => "",
"kdedir" => "",
"libpath" => "",
"lockfile" => "$ENV{HOME}/.kdecvs-lock",
"log-dir" => "log",
"make-install-prefix" => "",
"no-cvs" => "",
"no-rebuild-on-fail" => "",
"qtdir" => "",
"reconfigure" => "",
"recreate-configure" => "",
"refresh-build" => "",
"release-tag" => "",
"stop-on-failure" => "",
# Deprecated in v0.6. Logging is important, but doesn't
# make sense to all be dumped to stdout. I may add a simple
# 'stfu' switch later, but this one's gone.
# "make-output-file" => "make",
"disable-build-list" => "",
"manual-build" => "",
"pretend" => "",
"use-unsermake" => "",
"make-options" => "",
);
my %package_opts; # Holds module-specific options.
my @update_list; # List of modules to update/checkout.
my @build_list; # List of modules to build.
my $install_flag; # True if we're in install mode.
my $BUILD_ID; # Used by logging subsystem to create a unique log dir.
my $LOG_DATE; # Used by logging subsystem to create logs in same dir.
my $rcfile = "$ENV{HOME}/.kdecvs-buildrc";
# Subroutine definitions
# Subroutine to handle removing the lock file upon receiving a signal
sub quit_handler
{
print "Signal received, terminating.\n";
finish(5);
}
# Subroutine which returns true if pretend mode is on. Uses the prototype
# feature so you don't need the parentheses to use it.
sub pretending()
{
return get_option('global', 'pretend');
}
# Subroutine which returns true if debug mode is on. Uses the prototype
# feature so you don't need the parentheses to use it.
sub debugging()
{
return get_option('global', 'debug');
}
# Subroutine that returns the path of a file used to output the results of the
# build process. It accepts one parameter, which changes the kind of file
# returned. If the parameter is set to 'existing', then the file returned is
# the latest file that exists, or undef if no log has been created yet. This
# is useful for the --resume mode. All other values will return the name if a
# file that does not yet exist.
#
# All files will be stored in the log directory.
sub get_output_file
{
my $logdir;
my $mode;
$mode = shift or $mode = '';
my $fname;
print "get_output_file in mode $mode\n" if debugging;
if ($mode eq 'existing')
{
# There's two ways of finding the old file. Searching backwards with
# valid combinations of the date and build id, or just reading in the
# name from a known file or location. Since the latter option is much
# easier, that's what I'm going with. Note that this depends on the
# latest symlink being in place.
$logdir = get_subdir_path ('global', 'log-dir');
$fname = "$logdir/latest/build-status";
print "Old build status file is $fname\n" if debugging;
return "" if not -e $fname or not -r _;
return $fname;
}
# This call must follow the test above, because it changes the 'latest'
# symlink leading to failures later.
$logdir = get_log_dir('global');
$fname = "$logdir/build-status";
print "Build status file is $fname\n" if debugging;
return $fname;
}
# Subroutine to retrieve a subdirecty path for the given module.
# First parameter is the name of the module, and the second
# parameter is the option key (e.g. build-dir or log-dir).
sub get_subdir_path
{
my $module = shift;
my $option = shift;
my $dir = get_option($module, $option);
# If build-dir starts with a slash, it is an absolute path.
return $dir if $dir =~ /^\//;
# If it starts with a tilde, expand it out.
if ($dir =~ /^~/)
{
$dir =~ s/^~/$ENV{'HOME'}/;
}
else
{
# Relative directory, tack it on to the end of $kdecvs.
my $kdecvsdir = get_kdecvs_dir();
$dir = "$kdecvsdir/$dir";
}
return $dir;
}
# Convienience subroutine to get the cvs root dir.
sub get_kdecvs_dir
{
return get_option ('global', 'cvs-root');
}
# Convienience subroutine to return the build directory for a module. Use
# this instead of get_subdir_path because this special-cases modules for you,
# such as qt-copy.
sub get_build_dir
{
my $module = shift;
# It is the responsibility of the caller to append $module!
return get_kdecvs_dir() if ($module eq 'qt-copy') and not get_option('qt-copy', 'use-qt-builddir-hack');
return get_subdir_path($module, 'build-dir');
}
# Subroutine to return a list of the different log directories that are used
# by the different modules in the script.
sub get_all_log_directories
{
my @module_list = keys %package_opts;
my %log_dict;
unshift @module_list, "global";
$log_dict{get_subdir_path($_, 'log-dir')} = 1 foreach @module_list;
print "Log directories are ", join (", ", keys %log_dict), "\n" if debugging;
return keys %log_dict;
}
# Subroutine to determine the build id for this invocation of the script. The
# idea of a build id is that we want to be able to run the script more than
# once in a day and still retain each set of logs. So if we run the script
# more than once in a day, we need to increment the build id so we have a
# unique value. This subroutine sets the global variable $BUILD_ID and
# $LOG_DATE for use by the logging subroutines.
sub setup_logging_subsystem
{
my $min_build_id = "00";
my $date = strftime "%F", localtime; # ISO 8601 date
my @log_dirs = get_all_log_directories();
for (@log_dirs)
{
my $id = "01";
$id++ while -e "$_/$date-$id";
# We need to use a string comparison operator to keep
# the magic in the ++ operator.
$min_build_id = $id if $id gt $min_build_id;
}
$LOG_DATE = $date;
$BUILD_ID = $min_build_id;
print "\$LOG_DATE = $LOG_DATE\n" if debugging;
print "\$BUILD_ID = $BUILD_ID\n" if debugging;
}
# Convienience subroutine to return the log directory for a module.
# It also creates the directory and manages the 'latest' symlink.
#
# Returns undef on an error, or the name of the directory otherwise.
sub get_log_dir
{
my $module = shift;
my $logbase = get_subdir_path($module, 'log-dir');
my $logpath = "$logbase/$LOG_DATE-$BUILD_ID/$module";
$logpath = "$logbase/$LOG_DATE-$BUILD_ID" if $module eq 'global';
print "Log dir for $module is $logpath\n" if debugging;
if (not -e $logpath and not super_mkdir($logpath))
{
print "Unable to create log directory $logpath!\n";
print "\t$!\n";
return undef;
}
# Add symlink to the directory.
unlink("$logbase/latest") if -l "$logbase/latest";
system('ln', '-s', "$logbase/$LOG_DATE-$BUILD_ID", "$logbase/latest");
return $logpath;
}
# This subroutine returns an option value for a given module. Some
# globals can't be overridden by a module's choice. If so, the
# module's choice will be ignored, and a warning will be issued.
#
# Option names are case-sensitive!
#
# First parameter: Name of module
# Second paramenter: Name of option
sub get_option
{
my $module = shift;
my $option = shift;
# The #options override everything.
return $global_opts{"#$option"} if defined $global_opts{"#$option"};
# Configure flags and CXXFLAGS are appended to the global option
if (($module ne 'qt-copy' && $option eq 'configure-flags')
|| $option eq 'cxxflags')
{
my $value = $global_opts{$option};
if (exists $package_opts{$module}->{$option})
{
$value .= " $package_opts{$module}->{$option}";
}
return $value;
}
# These options can't override globals
if ($option eq "cvs-root" ||
$option eq "cvs-server" ||
$option eq "qtdir" ||
$option eq "libpath" ||
$option eq "binpath" ||
$option eq "kdedir" ||
$option eq "pretend" ||
$option eq "lockfile")
{
return $global_opts{$option};
}
# Everything else overrides the global, unless of course it's not set.
# If we're reading for global options, we're pretty much done.
if ($module eq 'global' || not exists $package_opts{$module}->{$option})
{
return $global_opts{$option};
}
else
{
return $package_opts{$module}->{$option};
}
}
# Subroutine to run a command with redirected STDOUT and STDERR. First parameter
# is name of the log file (relative to the log directory), and the
# second parameter is a reference to an array with the command and
# its arguments
sub log_command
{
my $pid;
my $module = shift;
my $filename = shift;
my @command = @{(shift)};
my $logdir = get_log_dir($module);
if (pretending)
{
print "\tWould have run ", join (' ', @command), "\n";
return 0;
}
if ($pid = fork)
{
# Parent
waitpid $pid, 0;
# If the module fails building, set an internal flag in the module
# options with the name of the log file containing the error message.
$package_opts{$module}{'#error-log-file'} = "$logdir/$filename.log" if $?;
return $?;
}
else
{
# Child
if (not defined $logdir or not -e $logdir)
{
# Error creating directory for some reason.
print "\tLogging to std out due to failure creating log dir.\n";
}
# Redirect stdout and stderr to the given file.
if (not debugging)
{
# Comment this out because it conflicts with make-install-prefix
# open (STDIN, "</dev/null");
open (STDOUT, ">$logdir/$filename.log") or do {
print "Error opening $logdir/$filename.log for logfile.\n";
print "\t$!\n";
};
}
else
{
open (STDOUT, "|tee $logdir/$filename.log") or do {
print "Error opening pipe to tee command.\n";
print "\t$!\n";
};
}
# Make sure we log everything.
open (STDERR, ">&STDOUT");
exec (@command) or do {
print "Unable to exec ", join (' ', @command), "!\n";
print "\t$!\n";
print "\tPlease check your binpath setting, PATH is currently $ENV{PATH}\n";
return $?;
};
}
}
# Subroutine to run the make command with the arguments given by the passed
# list. The first argument of the list given must be the module that we're
# making. The second argument is the "try number", used in creating the log
# file name.
sub safe_make (@)
{
my $module = shift;
my $trynumber = shift;
my $opts = get_option($module, 'make-options');
my $logdir = get_log_dir($module);
# Add make-options to the given options
unshift (@_, split(/\s/, $opts));
if (pretending)
{
$opts = join(' ', @_);
print "\tWould have run make $opts > $logdir/build-$trynumber\n";
return 0;
}
chdir (get_build_dir($module) . "/$module");
print "\tCompiling, attempt $trynumber...\n";
return log_command ($module, "build-$trynumber", ['make', @_] );
}
# Subroutine to add a variable to the environment, but ONLY if it
# is set. First parameter is the variable to set, the second is the
# value to give it.
sub setenv
{
my $var = shift;
my $val = shift;
return unless $val;
pretending ?
(print "\tWould have set $var=$val.\n") :
($ENV{$var} = $val);
}
# Display an error message to the user regarding their relative lack of
# ~/.kdecvs-buildrc, and point them to some help.
sub dead_whine
{
print <<"HOME";
Unable to open $rcfile!
$!
This file is necessary as it contains defintions for \$CVSROOT, among
other important variables!
For information on the format of .kdecvs-buildrc or for a sample file,
visit http://grammarian.homelinux.net/kdecvs-build/
HOME
exit (1); # We can't go on!
}
# This subroutine reads in the settings from the user's configuration
# file.
sub read_options
{
# The options are stored in the file $rcfile
open CONFIG, "<$rcfile" or dead_whine();
my ($option, $flags, $modulename);
# Read in global settings
OUTER: while (<CONFIG>)
{
s/#.*$//; # Remove comments
next if (/^\s*$/); # Skip blank lines
# First command in .kdecvs-buildrc should be a global
# options declaration, even if none are defined.
if (not /^global\s*$/)
{
print "Invalid configuration file $rcfile.\n";
print "Expecting global settings section!\n";
finish(1);
}
# Now read in each global option
while (<CONFIG>)
{
s/#.*$//; # Remove comments
next if /^\s*$/; # Skip blank lines
last OUTER if /^end\s+global/; # Stop
# The option is the first word, followed by the
# flags on the rest of the line. The interpretation
# of the flags is dependant on the option.
($option, $flags) = /^\s*([-a-zA-Z0-9]+)\s+(.*)$/;
# Replace tildes with home directory.
1 while ($flags =~ s/(^|:)~/$1$ENV{'HOME'}/);
$flags = 0 if $flags =~ /^false$/;
if ($option ne 'set-env')
{
$global_opts{$option} = $flags;
}
else
{
my ($var, @values) = split(/\s/, $flags);
$global_opts{'set-env'}{$var} = join(' ', @values);
}
}
}
# Now read in module settings
while (<CONFIG>)
{
s/#.*$//; # Remove comments
next if (/^\s*$/); # Skip blank lines
if (not /^module\s+[-\.\w]+\s*$/)
{
print "Invalid configuration file $rcfile!\n";
print "Expecting a start of module section.\n";
print "Global settings will be retained.\n";
}
# Get modulename
($modulename) = /^module\s+([-\.\w]+)\s*$/;
$package_opts{$modulename} = { }; # Set up defaults
$package_opts{$modulename}{'set-env'} = { };
while (<CONFIG>)
{
s/#.*$//; # Remove comments
next if (/^\s*$/); # Skip blank lines
last if (/^end\s+module/);
# Split into option and its flags.
($option, $flags) = /^\s*([-a-zA-Z0-9]+)\s+(.*?)\s*$/;
# Replace tildes with home directory.
1 while ($flags =~ s/(^|:)~/$1$ENV{'HOME'}/);
$flags = 0 if $flags =~ /^false$/;
if ($option ne 'set-env')
{
$package_opts{$modulename}{$option} = $flags;
}
else
{
my ($var, @values) = split(/\s/, $flags);
$package_opts{$modulename}{'set-env'}{$var} = join(' ', @values);
}
}
# Done reading options, add this module to the update list
push (@update_list, $modulename);
# Add it to the build list, unless the build is only
# supposed to be done manually.
if (not get_option ($modulename, 'manual-build'))
{
push (@build_list, $modulename);
}
}
close CONFIG;
}
# This subroutine reads the set-env option for a given module and initializes
# the environment based on that setting.
sub setup_module_environment
{
my $module = shift;
my ($key, $value);
# Let's see if the user has set env vars to be set.
my $env_hash_ref = get_option($module, 'set-env');
while (($key, $value) = each %{$env_hash_ref})
{
print "\tSetting $key to $value\n" if debugging;
}
$ENV{$key} = $value while (($key, $value) = each %{$env_hash_ref});
}
# Subroutine to initialize some environment variable for building
# KDE from CVS. Change this section if a dependency changes later.
sub initialize_environment
{
$ENV{"WANT_AUTOMAKE"} = "1.7";
$ENV{"WANT_AUTOCONF_2_5"} = "1";
$ENV{"PATH"} = get_option ('global', 'binpath');
my $cvsserver = get_option ('global', 'cvs-server');
$ENV{'CVS_RSH'} = 'ssh' if $cvsserver =~ /^:ext:/;
setup_module_environment ('global');
}
# Subroutine to get a list of modules to install, either from the command line
# if it's not empty, or based on the list of modules successfully built.
sub get_install_list
{
my @install_list;
if ($#ARGV > -1)
{
@install_list = @ARGV;
@ARGV = ();
}
else
{
# Get list of built items from $kdecvs/successfully-built
my $logdir = get_subdir_path('global', 'log-dir');
if (not open BUILTLIST, "<$logdir/latest/build-status")
{
print "Can't determine what modules have built. You must\n";
print "specify explicitly on the command line.\n";
exit (1); # Don't finish, not lock has been taken.
}
while (<BUILTLIST>)
{
chomp;
if (/Succeeded/)
{
s/^([^:]+):.*/$1/;
push @install_list, $_;
}
}
close BUILTLIST;
}
return @install_list;
}
# Subroutine to process the command line arguments. Any arguments so
# processed will be removed from @ARGV.
# The arguments are generally documented in doc.html now.
# NOTE: Don't call finish() from this routine, the lock hasn't been obtained.
# NOTE: The options have not been loaded yet either. Any option which
# requires more than rudimentary processing should set a flag for later work.
sub process_arguments
{
my $arg;
my $author = "Michael Pyne <michael.pyne\@kdemail.net>";
my $version = "kdecvs-build 0.80\n";
my @argv;
while ($_ = shift @ARGV)
{
SWITCH: {
/^(-v)|(--version)$/ && do { print $version; exit; };
/^--author$/ && do { print "$author\n"; exit; };
/^(-h)|(--help)$/ && do {
print <<DONE;
$version
This script automates (well, attempts to :-) ) the download, build,
and install process for KDE CVS.
You must first setup a .kdecvs-buildrc file in your home directory.
Please visit http://grammarian.homelinux.net/kdecvs-build/ for
information on how to write the file. There is also a simple GUI for
creating the file, which you can find at the above site.
Anyways, after setting up .kdecvs-buildrc, you can run this program
from either the command-line or from cron. It will automatically download
the modules from CVS, create the build system, and configure and make
the modules you tell it to. If you\'d like, you can use this program to
install KDE as well, if you\'re building KDE for a single user.
Basic synopsis, after setting up .kdecvs-buildrc:
\$ kdecvs-build [package names] (Download and make KDE from CVS)
\$ kdecvs-build --install [package names] (Install single-user KDE)
If you don\'t specify any particular package names, then your settings
in .kdecvs-buildrc will be used. If you DO specify a package name, then
your settings will still be read, but the script will try to build/install
the package regardless of .kdecvs-buildrc
Copyright (c) 2003, 2004 $author
The script is distributed under the terms of the GNU General Public License
v2, and includes ABSOLUTELY NO WARRANTY!!!
Options:
--no-cvs Skip contacting the CVS server.
--no-build Skip the build process.
--no-install Don't automatically install after build.
--cvs-only Update CVS only (Identical to --no-build at this
point).
--build-only Build only, don't CVS update or install.
--rc-file <filename> Read configuration from filename instead of default.
--debug Activates debug mode.
--pretend (or -p) Don't actually contact the CVS server, run make,
or create/delete files and directories. Instead,
output what the script would have done.
--resume Tries to resume the make process from the last time
the script was run, without performing the CVS
update.
--resume-from <pkg> Starts building from the given package, without
performing the CVS update.
--refresh-build Start the build from scratch.
--reconfigure Run configure again, but don't clean the build
directory or re-run make -f Makefile.cvs.
--recreate-configure Run make -f Makefile.cvs again to redo the configure
script.
--no-rebuild-on-fail Don't try to rebuild a module from scratch if it
failed building and we didn't already try to build it
from scratch.
--build-system-only Create the build infrastructure, but don't actually
perform the build.
--install Try to install the packages passed on the command
line, or all packages in ~/.kdecvs-buildrc that don't
have manual-build set. Building and CVS updates are
not performed.
--help You\'re reading it. :-)
--author Output the author(s)\'s name.
--version Output the program version.
You can get more help by reading the included HTML documentation, or going
online to http://grammarian.homelinux.net/kdecvs-build/
DONE
# We haven't done any locking... no need to finish()
# Avoids log-dir errors due to having not
# read_options() and setup_logging_subsystem().
exit 0;
};
/^--install$/ && do {
$install_flag = 1;
last SWITCH;
};
/^--no-cvs$/ && do {
$global_opts{'#no-cvs'} = 1;
last SWITCH;
};
/^--no-install$/ && do {
$global_opts{'#install-after-build'} = 0;
last SWITCH;
};
/^--debug$/ && do {
$global_opts{'#debug'} = 1;
last SWITCH;
};
/^--reconfigure$/ && do {
$global_opts{'#reconfigure'} = 1;
last SWITCH;
};
/^--recreate-configure$/ && do {
$global_opts{'#recreate-configure'} = 1;
last SWITCH;
};
/^--no-build$/ && do {
$global_opts{'#manual-build'} = 1;
last SWITCH;
};
# Although equivalent to --no-build at this point, someday the
# script may interpret the two differently, so get ready now.
/^--cvs-only$/ && do { # Identically to --no-build
$global_opts{'#manual-build'} = 1;
last SWITCH;
};
# Don't run CVS or install
/^--build-only$/ && do {
$global_opts{'#no-cvs'} = 1;
$global_opts{'#install-after-build'} = 0;
last SWITCH;
};
/^--build-system-only$/ && do {
$global_opts{'#build-system-only'} = 1;
last SWITCH;
};
/^--rc-file$/ && do {
$rcfile = shift @ARGV;
if (not $rcfile)
{
print "You must specify a filename to use as the config file!\n";
exit 8;
}
last SWITCH;
};
/^(--pretend)|(-p)$/ && do {
$global_opts{'#pretend'} = 1;
last SWITCH;
};
/^--refresh-build$/ && do {
$global_opts{'#refresh-build'} = 1;
last SWITCH;
};
/^--resume-from$/ && do {
$_ = shift @ARGV;
if (not $_)
{
print "You must pass a module to resume from to the --resume-from option!\n";
exit 7;
}
if (defined $global_opts{'#resume'})
{
print "WARNING: Don't pass both --resume and --resume-from\n";
delete $global_opts{'#resume'};
}
$global_opts{'#resume-from'} = $_;
$global_opts{'#no-cvs'} = 1;
last SWITCH;
};
/^--resume$/ && do {
if (defined $global_opts{'#resume'})
{
print "WARNING: Don't pass both --resume and --resume-from\n";
delete $global_opts{'#resume-from'};
}
$global_opts{'#resume'} = 1;
$global_opts{'#no-cvs'} = 1;
last SWITCH;
};
/^-/ && do { print "WARNING: Unknown option $_\n"; last SWITCH; };
push @argv, $_; # Reconstruct correct @ARGV
}
}
@ARGV = @argv;
}
# Subroutine to try to get a lock on the script's lockfile to prevent
# more than one script from updating KDE CVS at once.
# The value returned depends on the system's open() call. Normally 0
# is failure and non-zero is success (e.g. a file descriptor to read).
sub get_lock
{
my $lockfile = get_option ("global", "lockfile");
my $result = sysopen LOCKFILE, $lockfile, O_WRONLY | O_CREAT | O_EXCL;
# Very wordy way of saying to return if result == 0
return $result unless $result;
# Install signal handlers to ensure that the lockfile gets closed.
# There is a race condition here, but at worst we have a stale lock
# file, so I'm not *too* concerned.
$SIG{'HUP'} = \&quit_handler;
$SIG{'INT'} = \&quit_handler;
$SIG{'QUIT'} = \&quit_handler;
$SIG{'ABRT'} = \&quit_handler;
$SIG{'TERM'} = \&quit_handler;
$SIG{'PIPE'} = \&quit_handler;
}
# Subroutine to free the lock allocated by get_lock()
sub close_lock
{
my $lockfile = get_option ('global', "lockfile");
close LOCKFILE;
unlink $lockfile;
}
sub adjust_update_list
{
my $list_ref = shift;
my $build_ref = shift;
# Check to see if the user has requested that one of the modules to be
# built is using unsermake. If so, we need to check if kdenonbeta is
# already supposed to be checked out. If so, we need to make sure that
# unsermake is present in any checkout-only directives, and if not, we need
# to add kdenonbeta/unsermake to the checkout list.
my @unsermake_list;
my %existance_hash;
@unsermake_list = grep (get_option ($_, 'use-unsermake'), @{$list_ref});
# Create a hash to lookup quickly whether a given module is being built.
@existance_hash{@{$build_ref}} = 1 x @{$build_ref};
my $unsermake_needed = 0;
for (@unsermake_list)
{
if ($existance_hash{$_})
{
$unsermake_needed = 1;
last;
}
}
if ($unsermake_needed)
{
if (scalar grep (/^kdenonbeta$/, @{$list_ref}) == 0)
{
# kdenonbeta isn't being downloaded by the user.
unshift (@{$list_ref}, 'kdenonbeta');
$package_opts{'kdenonbeta'} = {
'manual-build' => 'true',
'checkout-only' => 'unsermake',
};
}
elsif (get_option ('kdenonbeta', 'checkout-only') and
get_option ('kdenonbeta', 'checkout-only') !~ /\bunsermake\b/)
{
# kdenonbeta is being checked out, but the user has
# excluded unsermake.
$package_opts{'kdenonbeta'}->{'checkout-only'} .= " unsermake";
}
}
}
# Subroutine to get the list of CVS modules to update. Returned
# as a list. Parse the command-line arguments first.
sub get_update_list
{
return @update_list if $#ARGV == -1;
return @ARGV;
}
# Subroutine to get the list of CVS modules to build. Returned
# as a list. A module will not be built if manual-build is set
# in the module's options. The command-line arguments should have been
# parsed first.
#
# This subroutine will handle the --resume and --resume-from options.
sub get_build_list
{
my $resume_point;
my $autoresuming;
if (get_option('global', '#manual-build'))
{
if (get_option('global', '#resume') || get_option('global',
'#resume-from'))
{
print "I'm confused, you enabled --no-build and --resume.\n";
print "Skipping the build process.\n";
}
return ();
}
if (get_option ('global', '#resume'))
{
if (scalar @ARGV > 0)
{
print "Ignoring modules specified on command line because --resume was set.\n";
}
# Try to determine location of last existing status file.
my $status_fname = get_output_file('existing');
if (not $status_fname)
{
print "Unable to open status file from last run, can't resume!\n";
return ();
}
my ($line, $oldline);
open STATUS_FILE, "<$status_fname" or do {
print "Can't open $status_fname, so I can't resume!\n";
print "\t$!\n";
return ();
};
while ($line = <STATUS_FILE>)
{
$oldline = $line;
}
close STATUS_FILE;
if (not defined $oldline)
{
# Hmm, empty file?
print "Unable to read information from resume status file.\n";
print "It's probably empty, but there's no way to resume!\n";
return ();
}
chomp $oldline;
print "The last success line is $oldline\n" if debugging;
($resume_point = $oldline) =~ s/^([^:]+):.*/$1/;
print "Resuming at $resume_point\n" if debugging;
}
elsif (get_option ('global', '#resume-from'))
{
$resume_point = get_option ('global', '#resume-from');
$autoresuming = 1;
}
if ($resume_point)
{
my $resume_found = 0;
# Pop stuff off of the list until we hit the resume point.
while (scalar @build_list > 0 and not $resume_found)
{
$resume_found = 1 if $build_list[0] eq $resume_point;
# If we're doing an auto resume, pop off the last package read
# from the file. If we're doing resume from on the other hand,
# I'm assuming the user intends to start with building that
# package.
shift @build_list unless $resume_found and $autoresuming;
}
return @build_list;
}
return @build_list if $#ARGV == -1;
return @ARGV;
}
# Helper subroutine for debugging purposes. Dumps all of the
# options which have been read in to %global_opts and %package_opts.
sub dump_options
{
my ($item, $ref_item, $ref);
foreach $item (keys %global_opts)
{
print "Global option $item is \"$global_opts{$item}\"\n";
}
foreach $item (keys %package_opts)
{
print "\nOptions for module $item:\n";
foreach $ref_item (keys %{$package_opts{$item}})
{
print "\tOption $ref_item is \"$package_opts{$item}{$ref_item}\"\n";
}
}
}
# Subroutine to unlink the given symlink if global-pretend isn't set.
sub safe_unlink
{
if (pretending)
{
print "\tWould have unlinked ", shift, ".\n";
return 1; # Return true
}
return unlink (shift);
}
# Subroutine to execute the system call on the given list if the pretend
# global option is not set.
sub safe_system(@)
{
if (not pretending)
{
print "\tExecuting ", join(" ", @_), "\n";
return system (@_) >> 8;
}
print "\tWould have run ", join(' ', @_), ".\n";
return 0; # Return true
}
# Helper subroutine to create a directory, including any parent
# directories that may also need created.
# Returns 0 on failure, non-zero on success
sub super_mkdir
{
my $pathname = shift;
my $temp;
my @parts = split (/\//, $pathname);
if (pretending)
{
print "\tWould have created $pathname\n";
return 1;
}
foreach (@parts)
{
$temp .= "$_/";
next if -e $temp;
return 0 if not mkdir ($temp);
}
return 1;
}
# Subroutine to remove a package from the package build list. This
# is for use when you've detected an error that should keep the
# package from building, but you don't want to abort completely.
sub dont_build
{
my $module = shift;
print "Not building $module\n" if debugging;
# Weed out matches of the module name
@build_list = grep (!/^$module$/, @build_list);
}
# Subroutine to checkout a CVS module, but to do so non-recursively.
# The first parameter should be the CVS module to check out.
# The second parameter should be the directory within the module to
# checkout.
#
# This subroutine handles one directory within the module at a time.
#
# It is important to remember that the admin directory is special. In
# this program, admin is added automatically to the list of directories
# to install when it is needed.
#
# Returns 0 on success, non-zero on failure.
#
# whenever a module is checked out piecewise.
sub checkout_cvs_partial_dir
{
my $module = shift;
my $dir = shift;
my $recurse = shift;
my @args;
my $kdecvs = get_option ("global", "cvs-root");
my $cvsroot = get_option ("global", "cvs-server");
my $update_dir;
chdir ("$kdecvs");
$update_dir = "$module/$dir";
if ($dir eq 'admin')
{
$update_dir = "$dir";
chdir "$module";
}
if (not -e $update_dir)
{
print ("Checking out $module/$dir.\n");
}
else
{
print ("Updating $module/$dir.\n");
}
@args = ('cvs', "-d$cvsroot");
push @args, (-e $update_dir) ? 'up' : 'co';
push @args, '-l' unless $recurse;
push @args, '-r', get_option($module, "release-tag") if (get_option($module, "release-tag"));
push @args, $update_dir;
my $fname = $dir; # $dir may itself contain slashes
$fname =~ s/\//-/g;
return run_cvs ($module, $fname, \@args);
}
# Subroutine to check out a specific set of directories from a module,
# instead of recursively checking out the entire module.
# The first parameter is the module to check out. The subroutine will
# automatically pull the list of directories to checkout from %package_opts.
# Only call the subroutine if the module has set a value to checkout-only.
sub checkout_cvs_partial
{
my $module = shift;
my @dirlist = split (/\s+/, get_option ($module, 'checkout-only'));
my @args;
my $kdecvs = get_kdecvs_dir();
my $cvsroot = get_option ('global', 'cvs-server');
my $result = 0;
my $item;
chdir ($kdecvs);
# Check if the user specified the admin subdirectory. If not,
# add it.
push (@dirlist, 'admin') if scalar grep (/^admin$/, @dirlist) == 0;
# Check out the module base.
@args = ('cvs', "-d$cvsroot");
push @args, (-e "$kdecvs/$module") ? 'up' : 'co', '-l';
push @args, '-r', get_option($module, "release-tag") if get_option($module, 'release-tag');
push @args, $module;
if (run_cvs ($module, "base-cvs", \@args))
{
print "\tError trying to partially checkout $module!\n$!\n";
print "\tThe module will be blocked from building.\n";
dont_build ($module);
return 1;
}
ITEM_LOOP: for $item (@dirlist)
{
# We need to split each item in this list into its respective directories.
# For example, we may be checking out kdenonbeta/applets/ksearchapplet. We
# need to (non-recursively) download kdenonbeta/applets, and then
# (recursively) kdenonbeta/applets/ksearchapplet. This is because of stuff
# like the Makefile.am files that are laying around.
my @dir_pieces = split('/', $item);
my $piece = shift @dir_pieces;
while (scalar (@dir_pieces))
{
# Don't recurse, we have more pieces.
if (checkout_cvs_partial_dir ($module, $piece, 0))
{
print "Unable to check out $module/$piece!\n";
print "Module $module will be blocked from building.\n";
dont_build ($module);
$result = 1;
next ITEM_LOOP;
}
$piece = join ('/', $piece, shift @dir_pieces);
}
# Recurse here, we're finished with prior dirs.
if (checkout_cvs_partial_dir ($module, $piece, 1))
{
print "Unable to check out $module/$piece!\n";
print "Module $module will be blocked from building.\n";
dont_build ($module);
$result = 1;
next;
}
}
return $result;
}
# Subroutine to ensure that the user has a cvs configuration. If not, one
# similar to the recommended version on developer.kde.org will be installed.
sub check_cvs_config
{
my $cvsroot = get_option ('global', 'cvs-server');
if (not -e "$ENV{HOME}/.cvsrc")
{
print "You do not seem to have a .cvsrc. Now creating a default... ";
open CVSRC, "> $ENV{HOME}/.cvsrc";
print CVSRC "cvs -z4 -q\n";
print CVSRC "diff -u3 -p\n";
print CVSRC "update -dP\n";
print CVSRC "checkout -P\n";
close CVSRC;
print "Done\n";
}
if (not -e "$ENV{HOME}/.cvspass")
{
# We need to login. We could use the Expect module to
# simulate a user login, but that would add another
# dependency for something which is really quite dumb.
# If the user doesn't login, then they will see warnings,
# but that should be it.
print <<EOF;
You need to login to CVS to avoid warnings about a missing .cvspass file!
At the command prompt, type \"cvs -d$cvsroot login\" without the quotes
and hit Enter. Then hit Enter again (to indicate a blank password) when
the prompt asks for your password.
EOF
}
}
# Subroutine to download the admin directory of a CVS module which has already
# been partially checked out for some reason, but checkout-only isn't set.
# Returns boolean true on success, or boolean false on an error.
sub download_admin_dir
{
my $module = shift;
my $kdecvs = get_kdecvs_dir();
my $admindir = "$kdecvs/$module/admin";
return 1 if $module eq 'qt-copy';
if (pretending)
{
print "\tWould have forced checkout of $admindir\n" if not -e "$admindir";
return 1;
}
if (not -e "$admindir")
{
print "\tForcing update of admin directory for $module.\n";
return not checkout_cvs_partial_dir($module, 'admin', 1);
}
return 1;
}
# Subroutine to update a list of CVS modules. The first
# parameter is a reference of a list of the modules to update.
# If the module has not already been checkout out, this subroutine
# will do so for you.
#
# Returns 0 on success, non-zero on error.
sub handle_updates
{
my $update_ref = shift;
my $kdecvs = get_kdecvs_dir();
my $cvsroot = get_option ('global', 'cvs-server');
my $result = 0;
my $module;
# No reason to print out the text if we're not doing anything.
return 0 if get_option ('global', 'no-cvs');
check_cvs_config();
print "<<< UPDATING CVS DIRECTORIES >>>\n\n";
if (not -e $kdecvs)
{
print "KDE CVS download directory doesn't exist, creating.\n";
if (not super_mkdir ($kdecvs))
{
print "Unable to make directory $kdecvs!\n$!\n";
@build_list = (); # Clear out the build list, since we can't build.
$install_flag = 0; # Can't install either.
return 1;
}
}
foreach $module (@{$update_ref})
{
if (not exists $package_opts{$module})
{
print "Unknown module $module, configure it in ~/.kdecvs-buildrc.\n";
next;
}
next if get_option($module, 'no-cvs');
my $command;
my $verb;
chdir ("$kdecvs");
if (get_option($module, 'checkout-only'))
{
# Don't check out the entire module, merely the
# parts the user wants
$result = 1 if checkout_cvs_partial ($module);
next;
}
if (-e "$kdecvs/$module/CVS")
{
# The CVS directory already exists, so it has probably already been
# checked out.
print "Updating $module\n";
# The admin directory SCREWS crap up though, make sure it's
# installed.
if (not download_admin_dir($module))
{
print "Can't download admin dir for $module!\n";
print "Removing from list of packages to build.\n";
dont_build($module);
$result = 1;
next;
}
$verb = 'updating';
$command = 'up';
}
else
{
print "Checking out $module\n";
$verb = 'checking out';
$command = 'co';
}
my @args = ('cvs', "-d$cvsroot", $command);
push @args, '-r', get_option($module, "release-tag") if get_option($module, "release-tag");
push @args, $module;
if (run_cvs($module, "cvs-$command", \@args))
{
print "Error $verb $module, removing from list of packages to build.\n";
dont_build ($module);
$result = 1;
}
print "\n";
}
print "<<< UPDATE COMPLETE >>>\n";
return $result;
}
# Subroutine to run the qt-copy apply_patches script. Assumes we're
# already in the right directory. Returns 0 on success, non-zero on
# failure.
sub safe_apply_patches
{
my $builddir = get_build_dir('qt-copy');
if (pretending)
{
print "\tWould have run ./apply_patches\n";
return 0;
}
print "\tApplying recommended Qt patches.\n";
chdir ("$builddir/qt-copy");
return (log_command('qt-copy', 'apply-patches', [ "./apply_patches" ]));
}
# Subroutine to run and log the configure command. First parameter is the
# path to the configure script to run, the second parameter is a scalar
# containing all of the configure flags to apply
sub safe_configure
{
my $kdecvs = get_kdecvs_dir();
my $module = shift;
my $script = "$kdecvs/$module/configure";
if (pretending)
{
print "\tWould have configured the module.\n";
return 0;
}
my @commands = split (/\s+/, get_option($module, 'configure-flags'));
# Get the user's CXXFLAGS
my $cxxflags = get_option ($module, 'cxxflags');
setenv ('CXXFLAGS', $cxxflags);
setenv ('DO_NOT_COMPILE', get_option ($module, 'do-not-compile'));
if ($module ne 'qt-copy')
{
my $kdedir = get_option ('global', 'kdedir');
push @commands, "CXXFLAGS=$cxxflags" if $cxxflags;
push @commands, "--prefix=$kdedir";
}
else
{
my $qtdir = get_build_dir('qt-copy') . '/qt-copy';
# Copy the configure script to accept the GPL license.
open CONFIG, "<$script";
open NEWCONFIG, ">$qtdir/configure.new";
while(<CONFIG>)
{
s/read acceptance/acceptance=yes/;
print NEWCONFIG $_;
}
close NEWCONFIG;
close CONFIG;
chmod 0755, "$qtdir/configure.new";
$script = "$qtdir/configure.new";
print "\tGPL license selected for Qt. See $kdecvs/qt-copy/LICENSE.GPL\n";
}
print "\tRunning configure...\n";
unshift @commands, $script;
return log_command($module, "configure", \@commands);
}
# Subroutine to create the build system for a module. This involves making
# sure the directory exists and then running make -f Makefile.cvs. This
# subroutine assumes that the module is already downloaded.
sub safe_create_build_system
{
my $kdecvs = get_kdecvs_dir();
my $builddir = get_build_dir ('qt-copy'); # Only used for qt-copy
my $module = shift;
my $instapps = get_option($module, 'inst-apps');
if (pretending)
{
print "\tWould have created $module\'s build system.\n";
return 0;
}
chdir ("$kdecvs/$module");
chdir ("$builddir/$module") if $module eq 'qt-copy' and get_option('qt-copy', 'use-qt-builddir-hack');
if ($instapps)
{
open (INSTAPPS, ">inst-apps") or do {
print "\tUnable to create inst-apps file!\n$!\n";
return 1;
};
print INSTAPPS "$instapps\n";
close INSTAPPS;
}
else
{
unlink ($instapps);
}
if (log_command ($module, "build-system", [ "make", "-f", "Makefile.cvs" ]))
{
print "\tUnable to create build system for $module\n";
return 1;
}
return 0;
}
# Subroutine to determine if a given module needs to have the build system
# recreated from scratch.
# If so, it returns boolean true.
sub needs_refreshed
{
my $kdecvs = get_kdecvs_dir();
my $module = shift;
my $builddir = get_build_dir ($module);
my $conf_file_key = "Makefile"; # File that exists after configure is run
# Use a different file to indicate configure has been run for qt-copy
$conf_file_key = "src/tools/qconfig.cpp" if $module eq 'qt-copy';
if (debugging)
{
print "Build directory not setup for $module.\n" if not -e "$builddir/$module";
print ".refresh-me exists.\n" if -e "$builddir/$module/.refresh-me";
print "refresh-build option set.\n" if get_option($module, 'refresh-build');
print "Can't find configure key file.\n" if not -e "$builddir/$module/$conf_file_key";
}
return 1 if ((not -e "$builddir/$module") ||
(-e "$builddir/$module/.refresh-me") ||
get_option($module, "refresh-build") ||
(not -e "$builddir/$module/$conf_file_key"));
return 0;
}
sub run_cvs
{
my $module = shift;
my $logfilename = shift;
my $arg_ref = shift;
my %hash_count;
my $result;
my $force_refresh = 0;
my $logdir = get_log_dir($module);
# Do cvs update.
$result = log_command($module, $logfilename, $arg_ref);
# There will be no result if we're pretending, so don't even
# bother.
return 0 if pretending;
$logfilename = "$logdir/$logfilename.log";
# We need to open the file and try to determine what the CVS process
# did.
open CVS_LOG, "<$logfilename";
while (<CVS_LOG>)
{
# Count updates and patches together.
$hash_count{'updated'}++ if /^U /;
$hash_count{'updated'}++ if /^P /;
$hash_count{'added'}++ if /^A /;
$hash_count{'removed'}++ if /^R /;
$hash_count{'modified'}++ if /^M /;
$hash_count{'conflicted'}++ if /^C /;
# Check if we need to force a refresh.
$force_refresh = 1 if /^A / and /Makefile\.am/;
}
close CVS_LOG;
my %endings = (
'updated' => 'files were updated',
'1updated' => 'file was updated',
'added' => 'files were added',
'1added' => 'file was added',
'removed' => 'files were removed',
'1removed' => 'file was removed',
'modified' => 'files were modified',
'1modified' => 'file was modified',
'conflicted' => 'files had conflicts',
'1conflicted' => 'file had conflicts',
);
my ($key, $value);
while (($key, $value) = each %hash_count)
{
next unless $value > 0;
my $ending_key = $value > 1 ? $key : ('1' . $key);
my $ending = $endings{$ending_key};
print "\t$value $ending.\n";
}
if ($force_refresh)
{
print "A new Makefile.am was added, the build system will be recreated.\n";
$package_opts{$module}{'refresh-build'} = 1;
$package_opts{$module}{'#cancel-clean'} = 1;
}
return $result;
}
# Subroutine to clean the build system for the given module. Works by
# recursively deleting the directory and then recreating it. Returns
# 0 for failure, non-zero for success.
sub clean_build_system
{
my $module = shift;
my $moduledir = get_kdecvs_dir() . "/$module";
my $builddir = get_build_dir ($module);
if (pretending) {
print "\tWould have cleaned build system for $module.\n";
return 1
};
if (not -e $moduledir)
{
print "\tUnable to clean build system for $module, it's not been checked out!\n";
return 0;
}
# Clean qt-copy separately
if ($module eq 'qt-copy')
{
if (get_option ('qt-copy', 'use-qt-builddir-hack'))
{
if (log_command ('qt-copy', 'clean-builddir', ['rm', '-rf', "$builddir/qt-copy"]))
{
print "Error refreshing qt-copy builddir!\n";
return 0;
}
}
else
{
chdir ("$builddir/qt-copy");
if (log_command ('qt-copy', 'clean', ['make', 'clean']))
{
print "WARNING: Error cleaning qt-copy.\n";
}
unlink ("$builddir/qt-copy/.qmake.cache");
}
return 1;
}
elsif (-e "$builddir/$module" &&
safe_system ('rm', '-rf', "$builddir/$module"))
{
# Remove build directory for normal module.
print "\tUnable to unlink $builddir/$module, skipping.\n";
return 0; # False for this function.
}
# Now create the directory
if (not -e "$builddir/$module" and not super_mkdir ("$builddir/$module"))
{
print "\tUnable to create directory $builddir/$module, skipping.\n";
return 0;
}
return 1;
}
# Subroutine to setup the build system in a directory. The first parameter
# is the module name. Returns boolean true on success, boolean false (0)
# on failure.
sub setup_build_system
{
my $module = shift;
my $kdecvs = get_kdecvs_dir();
my $do_configure = get_option ($module, 'reconfigure');
my $do_makeconf = get_option ($module, 'recreate-configure');
my $builddir = get_build_dir ($module);
if (needs_refreshed($module))
{
# The build system needs created, either because it doesn't exist, or
# because the user has asked that it be completely rebuilt.
print "\tPreparing build system for $module.\n";
# Define this option to tell later functions that we tried to rebuild
# this module.
$package_opts{$module}->{'#was-rebuilt'} = 1;
# Check to see if we're actually supposed to go through the cleaning
# process.
if (not $package_opts{$module}->{'#cancel-clean'} and
not clean_build_system($module))
{
print "\tUnable to clean $module!\n";
return 0;
}
$do_makeconf = 1;
}
if ($module eq 'qt-copy' && get_option($module, 'use-qt-builddir-hack'))
{
if (log_command ('qt-copy', 'create-builddir', ['cp', '-af',
"$kdecvs/$module", "$builddir" ]))
{
print "Error creating qt-copy build system!\n";
return 0;
}
}
if ($do_makeconf or not -e "$kdecvs/$module/configure")
{
print "\tRecreating configure script.\n";
# Note this is the checkout directory, not the build directory
# This will equal $builddir for qt-copy.
chdir ("$kdecvs/$module");
# Update the PATH and other important environment variables.
update_module_environment ($module);
if (safe_create_build_system ($module))
{
print "\tUnable to create configure system from checkout.\n";
return 0;
}
$do_configure = 1;
if (($module eq "qt-copy") && get_option($module, 'apply-qt-patches'))
{
# Run apply-patches script
return 0 if safe_apply_patches ();
}
# Check to see if we're supposed to stop here
return 1 if get_option ($module, 'build-system-only');
}
$do_configure = 1 if $module eq 'qt-copy' and not -e "$builddir/qt-copy/src/tools/qconfig.cpp";
if ($do_configure || not -e "$builddir/$module/Makefile")
{
# Now we're in the checkout directory
# So, switch to the build dir.
# builddir is automatically set to the right value for qt-copy
if (not chdir ("$builddir/$module") and not pretending)
{
print "\tUnable to change directory to $builddir/$module!!\n";
return 0;
}
# configure the module
if (safe_configure ($module))
{
print "\tUnable to configure $module!\n";
return 0;
}
}
return 1;
}
# Subroutine to setup the environment for a module. First parameter is the name of
# the module to set the environment for
sub update_module_environment
{
my $module = shift;
my $kdecvs = get_kdecvs_dir();
my $kdedir = get_option ($module, 'kdedir');
my $qtdir = get_option ($module, 'qtdir');
my $path = join(':', "$qtdir/bin", "$kdedir/bin", get_option ($module, 'binpath'));
my $libdir = join(':', "$qtdir/lib", "$kdedir/lib", get_option ($module, 'libpath'));
# Set up the children's environment. We use setenv since it
# won't set an environment variable to nothing. (e.g, setting
# QTDIR to a blank string might confuse Qt or KDE.
# Remove leading and trailing colons, just in case.
# Also remove more than one colon.
for ($path, $libdir)
{
s/^:*//;
s/:*$//;
s/:+/:/;
}
setenv ('LD_LIBRARY_PATH', $libdir);
setenv ('PATH', $path);
setenv ('KDEDIR', $kdedir);
setenv ('QTDIR', $qtdir);
# Everyone loves unsermake. It's a pity that not every module will compile with it.
# Benjamin Meyer has an excellent article about speeding up distributed builds using
# unsermake. You should notice a much faster build using distcc, and
# a slightly faster build even with only one CPU.
if (get_option ($module, "use-unsermake"))
{
setenv ("UNSERMAKE", "$kdecvs/kdenonbeta/unsermake/unsermake");
}
else
{
delete $ENV{'UNSERMAKE'}; # Force removal from environment
}
# Qt has several defines of its own. Special case qt-copy for this
# reason.
setenv ("YACC", 'byacc -d') if ($module eq "qt-copy");
# Read in user environment defines
setup_module_environment ($module);
}
# Subroutine to make sure the build directory for a module is setup.
# The module to setup is the first parameter.
#
# Returns boolean true on success, boolean false on failure.
sub setup_build_directory
{
my $module = shift;
my $builddir = get_build_dir($module);
if (not -e "$builddir")
{
print "\t$builddir doesn't exist, creating.\n";
if (not super_mkdir ("$builddir"))
{
print "\tUnable to create $builddir!\n$!\n";
return 0;
}
}
return 1;
}
# Subroutine to return a string suitable for displaying an elapsed time, (like
# a stopwatch) would. The first parameter is the number of seconds elapsed.
sub prettify_seconds
{
my $elapsed = $_[0];
my $str = "";
my ($days,$hours,$minutes,$seconds,$fraction);
$fraction = int (100 * ($elapsed - int $elapsed));
$elapsed = int $elapsed;
$seconds = $elapsed % 60;
$elapsed = int $elapsed / 60;
$minutes = $elapsed % 60;
$elapsed = int $elapsed / 60;
$hours = $elapsed % 24;
$elapsed = int $elapsed / 24;
$days = $elapsed;
$seconds = "$seconds.$fraction" if $fraction;
my @str_list;
for (qw(days hours minutes seconds))
{
# Use a symbolic reference without needing to disable strict refs.
# I couldn't disable it even if I wanted to because these variables
# aren't global or localized global variables.
my $value = eval "return \$$_;";
my $text = $_;
$text =~ s/s$// if $value == 1; # Make singular
push @str_list, "$value $text" if $value or $_ eq 'seconds';
}
# Add 'and ' in front of last element if there was more than one.
push @str_list, ("and " . pop @str_list) if (scalar @str_list > 1);
$str = join (", ", @str_list);
print "Time from $_[0] was $str.\n" if debugging;
return $str;
}
# Subroutine to build a given module. The module to build is the first
# parameter.
#
# Returns boolean false on failure, boolean true on success.
sub build_module
{
my $module = shift;
my $builddir = get_build_dir ($module);
my $trynumber = 1;
# Do some tests to make sure we're ready to build.
if (not exists $package_opts{$module})
{
print "Unknown module $module, configure it in ~/.kdecvs-buildrc.\n";
return 0;
}
update_module_environment($module);
my $start_time = time;
while (not defined $package_opts{$module}->{'#was-rebuilt'})
{
print "Building $module\n";
return 0 if not setup_build_directory($module);
return 0 if not setup_build_system($module);
return 1 if (get_option ($module, 'build-system-only'));
if (safe_make ($module, $trynumber))
{
# Build failed
# There are several reasons why the build could fail. If we're
# using unsermake for this module, then perhaps we just need to
# run make again. After that, we can re-run make -f Makefile.cvs
# and etc and then try make again. If that STILL doesn't work, we
# can try rm -rf $builddir/$module and rebuild.
my $elapsed = prettify_seconds (time - $start_time);
my $was_rebuilt = defined $package_opts{$module}{'#was-rebuilt'};
$start_time = time;
++$trynumber;
if ($trynumber > 3 or $was_rebuilt or get_option ($module, 'no-rebuild-on-fail'))
{
# Well we tried, but it isn't going to happen.
print "\n\tUnable to build $module!\n";
print "\tTook $elapsed of time.\n";
return 0;
}
if ($trynumber == 2)
{
# Just try again
print "\n\tCouldn't build, going to try again just in case.\n";
print "\tTook $elapsed of time.\n";
next;
}
# Don't remove the old modules, but re-run make -f
# Makefile.cvs and configure.
print "\n\tStill couldn't build, recreating build system (builddir is safe).\n";
print "\tTook $elapsed of time.\n";
$package_opts{$module}->{'#cancel-clean'} = 1;
$package_opts{$module}->{'refresh-build'} = 1;
# Loop again
}
else
{
# Build succeeded
my $elapsed = prettify_seconds (time - $start_time);
my $do_install = get_option($module, 'install-after-build');
print "\tBuild done after $elapsed.\n";
$do_install ? handle_install($module)
: print "\tSkipping install for $module\n";
last; # Don't forget to exit the loop!
}
}
return 1;
}
# Subroutine to handle the build process.
# First parameter is a reference of a list containing the packages
# we are to build.
# If the packages are not already checked-out and/or updated, this
# subroutine WILL NOT do so for you.
#
# This subroutine assumes that the $kdecvs directory has already been
# set up. It will create $builddir if it doesn't already exist.
#
# If $builddir/$module/.refresh-me exists, the subroutine will
# completely rebuild the module.
#
# Returns 0 for success, non-zero for failure.
sub handle_build
{
my @fail_list;
my @build_done;
my $build_ref = shift;
my $kdecvs = get_kdecvs_dir();
my $cvsroot = get_option ('global', 'cvs-server');
my $module;
my $result;
my $outfile = get_output_file ();
# No reason to print building messages if we're not building.
return 0 if (scalar (@{$build_ref}) == 0);
print "\n<<< BUILD PROCESS >>>\n";
# Save the environment to keep module's env changes from affecting other
# modules.
my %env_backup = %ENV;
if (pretending)
{
print "\tWould have opened status file $outfile.\n";
$outfile = undef; # Don't actually try it though.
}
if ($outfile)
{
open STATUS_FILE, ">$outfile" or do {
print "\t!Unable to open output status file $outfile\n";
print "\t$!\n";
print "\tYou won't be able to use the --resume switch next run.\n";
$outfile = undef;
};
}
foreach $module (@{$build_ref})
{
my $start_time = time;
if (build_module ($module))
{
my $elapsed = prettify_seconds(time - $start_time);
print STATUS_FILE "$module: Succeeded after $elapsed.\n" if $outfile;
print "\tOverall time for $module was $elapsed.\n";
push @build_done, $module;
}
else
{
my $elapsed = prettify_seconds(time - $start_time);
print STATUS_FILE "$module: Failed after $elapsed.\n" if $outfile;
print "\tOverall time for $module was $elapsed.\n";
push @fail_list, $module;
if (get_option($module, 'stop-on-failure'))
{
print "\n$module didn't build, stopping here.\n";
return 1; # Error
}
}
print "\n";
%ENV = %env_backup;
}
close STATUS_FILE;
print "<<< BUILD DONE >>>\n";
print "\n<<< PACKAGES SUCCESSFULLY BUILT >>>\n";
if (not get_option('global', 'disable-build-list') and not pretending)
{
# Print out results, and output to a file
open BUILT_LIST, ">$kdecvs/successfully-built";
foreach $module (@build_done)
{
print "$module\n";
print BUILT_LIST "$module\n";
}
close BUILT_LIST;
}
else
{
# Just print out the results
print (join ("\n", @build_done), "\n");
}
if (scalar @fail_list > 0)
{
my $homedir = $ENV{'HOME'};
my $logfile;
print "\n<<< PACKAGES FAILED BUILDING >>>\n";
for (@fail_list)
{
$logfile = $package_opts{$_}{'#error-log-file'};
$logfile = "No log file" unless $logfile;
$logfile =~ s|$homedir|~|;
print "$_ - $logfile\n";
}
}
return ((scalar @fail_list) > 0) ? 1 : 0;
}
# Subroutine to exit the script cleanly, including removing any
# lock files created. If a parameter is passed, it is interpreted
# as an exit code to use
sub finish
{
my $exitcode = shift;
my $logdir = get_log_dir('global');
$exitcode = 0 unless $exitcode;
close_lock();
print "\nYour logs are saved in $logdir\n";
exit $exitcode;
}
# Subroutine to handle the installation process. Simply calls
# 'make install' in the directory.
sub handle_install
{
my $result = 0;
for my $module (@_)
{
my $builddir = get_build_dir ($module);
if ($module eq "qt-copy")
{
print "\tqt-copy doesn't need installed.\n";
next;
}
if (not exists $package_opts{$module})
{
print "\tUnknown module $module, configure it in ~/.kdecvs-buildrc.\n";
next;
}
if (not -e "$builddir/$module" ||
not -e "$builddir/$module/Makefile")
{
print "\tThe build system doesn't exist for $module.\n";
print "\tTherefore, we can't install it. :-(.\n";
next;
}
chdir ("$builddir/$module");
if (pretending)
{
print "\tWould have installed $module\n";
next;
}
# Add make-install-prefix options.
my @prefix = split(/\s/, get_option ($module, 'make-install-prefix'));
my @args = (@prefix, 'make', 'install');
# Just in case, I guess.
print "Installing $module\n";
update_module_environment ($module);
if (log_command ($module, "install", \@args))
{
print "\tUnable to install $module!\n";
$result = 1;
if (get_option($module, 'stop-on-failure'))
{
print "Stopping here.\n";
return 1; # Error
}
}
}
return $result;
}
# Script starts.
# Use some exception handling to avoid ucky error messages
eval
{
# Note to self: Quit changing the order around.
process_arguments(); # Process --help, --install, etc. first.
read_options(); # If we're still here, read the options
initialize_environment(); # Initialize global env vars.
setup_logging_subsystem(); # Setup logging directories.
dump_options() if debugging;
};
if ($@)
{
# We encountered an error.
print "Encountered an error in the execution of the script.\n";
print "The error reported was $@\n";
print "Please e-mail a bug report to michael.pyne\@kdemail.net\n";
print "with this information.\n";
# Don't finish, because we haven't attained the lock yet.
exit 99;
}
if (not get_lock())
{
print "$0 is already running!\n";
exit 0; # Don't finish(), it's not our lockfile!!
}
# Now use an exception trapping loop that calls finish().
my $result;
eval
{
my $time = localtime;
print "Script started processing at $time\n";
@update_list = get_update_list();
@build_list = get_build_list();
print "Build list is ", join (', ', @build_list), "\n" if debugging;
# Make sure unsermake is checked out automatically if needed
adjust_update_list(\@update_list, \@build_list);
if (not $install_flag)
{
# No packages to install, we're in build mode
$result = handle_updates (\@update_list);
$result = handle_build (\@build_list) || $result;
}
else
{
# Installation mode. Check to make sure nothing's
# being updated.
if ($#ARGV > 0)
{
# We have packages specified on the command line.
print "Parameters ignored because we are installing:\n\t",
join (', ', @ARGV), "\n";
}
$result = handle_install (get_install_list());
}
$time = localtime;
print "Script finished processing at $time\n";
};
if ($@)
{
# We encountered an error.
print "Encountered an error in the execution of the script.\n";
print "The error reported was $@\n";
print "Please e-mail a bug report to michael.pyne\@kdemail.net\n";
print "with this information.\n";
# Don't finish, because we haven't attained the lock yet.
finish (99);
}
finish($result);
# vim: set et sw=4 ts=4: