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.
2015 lines
60 KiB
2015 lines
60 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" => "", |
|
"install-after-build" => "1", # Default to true |
|
"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_list; # List of modules to install. |
|
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. |
|
|
|
# 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; |
|
return $?; |
|
} |
|
else |
|
{ |
|
# Child |
|
if (not defined $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 get_option('global', 'debug')) |
|
{ |
|
# 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"; |
|
}; |
|
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 $ENV{HOME}/.kdecvs-buildrc! |
|
$! |
|
|
|
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 |
|
finish (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 $ENV{HOME}/.kdecvs-buildrc |
|
my $config_file = "$ENV{HOME}/.kdecvs-buildrc"; |
|
open CONFIG, "<$config_file" 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 $config_file.\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$/; |
|
$global_opts{$option} = $flags; |
|
} |
|
} |
|
|
|
# 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 $config_file!\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 |
|
|
|
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$/; |
|
$package_opts{$modulename}->{$option} = $flags; |
|
} |
|
|
|
# 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; |
|
} |
|
|
|
# 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:/; |
|
} |
|
|
|
# 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. |
|
sub process_arguments |
|
{ |
|
my $arg; |
|
my $author = "Michael Pyne <mpyne\@grammarian.homelinux.net>\n"; |
|
my $version = "kdecvs-build 0.73-pre1\n"; |
|
my @argv; |
|
|
|
while ($_ = shift @ARGV) |
|
{ |
|
SWITCH: { |
|
/^(-v)|(--version)$/ && do { print $version; exit; }; |
|
/^--author$/ && do { print $author; exit; }; |
|
/^(-h)|(--help)$/ && do { |
|
print <<DONE; |
|
kdecvs-build version $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 too. 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 Michael Pyne <mpyne\@grammarian.homelinux.net> |
|
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. Automatic |
|
install will still happen if install-after-build is |
|
set to true for the module in the config file. |
|
--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. |
|
--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. |
|
--help You\'re reading it. :-) |
|
--author Output the author(s)\'s name. |
|
--version Output the program version. |
|
DONE |
|
finish(); |
|
}; |
|
|
|
/^--install$/ && do { |
|
if ($#ARGV > -1) |
|
{ |
|
@install_list = @ARGV; |
|
@ARGV = (); |
|
} |
|
else |
|
{ |
|
# Get list of built items from $kdecvs/successfully-built |
|
my $kdecvs = get_kdecvs_dir(); |
|
|
|
if (not open BUILTLIST, "<$kdecvs/successfully-built") |
|
{ |
|
print "Can't determine what modules have built. You must\n"; |
|
print "specify explicitly on the command line.\n"; |
|
finish (1); |
|
} |
|
|
|
@install_list = <BUILTLIST>; |
|
chomp (@install_list); |
|
close BUILTLIST; |
|
} |
|
|
|
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; |
|
@build_list = (); |
|
last SWITCH; |
|
}; |
|
|
|
/^--build-system-only$/ && do { |
|
$global_opts{'#build-system-only'} = 1; |
|
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; |
|
} |
|
|
|
# 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; |
|
|
|
# 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_list = (); # 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); |
|
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 "Applying 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; |
|
|
|
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 (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 $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 /; |
|
} |
|
|
|
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"; |
|
} |
|
|
|
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); |
|
|
|
# Make sure the module's been checked out. |
|
return 0 if (not -e $moduledir); |
|
|
|
# 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', '-a', |
|
"$kdecvs/$module", "$builddir/qt-copy" ])) |
|
{ |
|
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"); |
|
} |
|
|
|
# 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 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); |
|
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. |
|
|
|
print "Build failed.\n"; |
|
++$trynumber; |
|
if ($trynumber == 2) |
|
{ |
|
# Just try again |
|
print "\n\tCouldn't build, going to try again just in case.\n"; |
|
next; |
|
} |
|
|
|
if ($trynumber > 3 or |
|
(not defined $package_opts{$module}->{'#was-rebuilt'} and |
|
get_option ($module, 'no-rebuild-on-fail'))) |
|
{ |
|
# Well we tried, but it isn't going to happen. |
|
print "\n\tUnable to build $module!\n"; |
|
return 0; |
|
} |
|
|
|
elsif ($trynumber == 3) |
|
{ |
|
# 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"; |
|
$package_opts{$module}->{'#cancel-clean'} = 1; |
|
$package_opts{$module}->{'refresh-build'} = 1; |
|
} |
|
} |
|
elsif (get_option($module, "install-after-build")) |
|
{ |
|
handle_install($module); |
|
} |
|
else |
|
{ |
|
print "\tModule built successfully, install skipped.\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}) |
|
{ |
|
if (build_module ($module)) |
|
{ |
|
print STATUS_FILE "$module: Succeeded.\n" if $outfile; |
|
push @build_done, $module; |
|
} |
|
elsif (get_option($module, 'stop-on-failure')) |
|
{ |
|
print STATUS_FILE "$module: Failed.\n" if $outfile; |
|
print "\n$module didn't build, stopping here.\n"; |
|
return 1; # Error |
|
} |
|
else |
|
{ |
|
print STATUS_FILE "$module: Failed.\n" if $outfile; |
|
push @fail_list, $module; |
|
} |
|
|
|
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) |
|
{ |
|
print "\n<<< PACKAGES FAILED BUILDING >>>\n"; |
|
print join ("\n", @fail_list), "\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 |
|
{ |
|
process_arguments(); |
|
read_options(); |
|
initialize_environment(); |
|
setup_logging_subsystem(); |
|
|
|
dump_options() if get_option('global', 'debug'); |
|
}; |
|
|
|
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 mpyne\@grammarian.homelinux.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 ($#install_list == -1) |
|
{ |
|
# No packages to install, we're in build mode |
|
$result = handle_updates (\@update_list); |
|
$result = handle_build (\@build_list) unless $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 (@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 mpyne\@grammarian.homelinux.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:
|
|
|