#!/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. # 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" => "", "manual-build" => "", "manual-update" => "", "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 %ignore_list; # List of packages to refuse to include in the build list. my @update_list; # List of modules to update/checkout. my @build_list; # List of modules to build. my @failed_list; # List of modules that failed to update. my @install_fail; # List of modules that failed to install. 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 (debugging) { print "log_command(): Module $module, Command: ", join(' ', @command), "\n"; } 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, "$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. # # Returns 0 on success, non-zero on failure (shell script style) sub safe_make (@) { my $module = shift; my $trynumber = shift; my $opts = get_option($module, 'make-options'); my $logdir = get_log_dir($module); my $checkout_dirs = get_option($module, "checkout-only"); my @dirs = split(' ', $checkout_dirs); my $installing = $trynumber eq 'install'; my $make = 'make'; # Add make-options to the given options, as long as we're not installing # If we are installing, unsermake seems to assume that the options are a # make target, and parallel builds don't help with installing anyways. unshift (@_, split(' ', $opts)) unless $installing; $make = 'unsermake' if get_option($module, 'use-unsermake'); # Check if we're installing if ($installing) { print "Prepending install options.\n" if debugging; unshift @_, $make, 'install'; unshift @_, split(' ', get_option ($module, 'make-install-prefix')); } else { unshift @_, $make; } push (@dirs, "") if scalar @dirs == 0; print $installing ? "\tInstalling $module\n" : "\tCompiling, attempt $trynumber...\n"; for my $subdir (@dirs) { next if $subdir eq 'admin'; my $logname = $installing ? "install" : "build-$trynumber"; if ($subdir ne '') { $logname = $installing ? "install-$subdir" : "build-$subdir-$trynumber"; } if (pretending) { $opts = join(' ', @_); print "\tWould have switched directory to ", get_build_dir($module) . "/$module/$subdir\n"; print "\tWould have run $make $opts > $logdir/$logname\n"; next; } print $installing ? "\tInstalling " : "\tBuilding ", "subdirectory $subdir\n" if $subdir ne ''; chdir (get_build_dir($module) . "/$module/$subdir"); my $result = log_command ($module, $logname, [@_] ); return $result if $result; } return 0; } # 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 () { 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 () { 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 () { 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 () { 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) unless exists $ignore_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') and not exists $ignore_list{$modulename}) { 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:/; my $pc_path = $ENV{'PKG_CONFIG_PATH'}; if ($ENV{'PKG_CONFIG_PATH'}) { $ENV{'PKG_CONFIG_PATH'} = get_option('global', 'kdedir') . "/lib/pkgconfig:$pc_path"; } else { $ENV{'PKG_CONFIG_PATH'} = get_option('global', 'kdedir') . "/lib/pkgconfig"; } 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 () { chomp; if (/Succeeded/) { s/^([^:]+):.*/$1/; push @install_list, $_; } } close BUILTLIST; } return @install_list; } # Print out an error message, and a list of modules that match that error # message. It will also display the log file name if one can be determined. # The message will be displayed all in uppercase, with PACKAGES prepended, so # all you have to do is give a descriptive message of what this list of # packages failed at doing. sub output_failed_module_list($@) { my ($message, @fail_list) = @_; $message = uc $message; # Be annoying print "Message is $message\n" if debugging; print "\tfor ", join(', ', @fail_list), "\n" if debugging; if (scalar @fail_list > 0) { my $homedir = $ENV{'HOME'}; my $logfile; print "\n<<< PACKAGES $message >>>\n"; for (@fail_list) { $logfile = $package_opts{$_}{'#error-log-file'}; $logfile = "No log file" unless $logfile; $logfile =~ s|$homedir|~|; print "$_ - $logfile\n"; } } } # 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 "; my $version = "kdecvs-build 0.87\n"; my @argv; while ($_ = shift @ARGV) { SWITCH: { /^(-v)|(--version)$/ && do { print $version; exit; }; /^--author$/ && do { print "$author\n"; exit; }; /^(-h)|(--help)$/ && do { print < 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 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; }; /^--ignore-modules$/ && do { # We need to keep read_options() from adding these modules to # the build list, taken care of by ignore_list. We then need # to remove the modules from the command line, taken care of # by the @ARGV = () statement; my @options = (); foreach (@ARGV) { if (/^-/) { push @options, $_; } else { $ignore_list{$_} = 1; # the pattern match doesn't work with $_, alias it. my $module = $_; @argv = grep (!/^$module$/, @argv); } } @ARGV = @options; 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 @ARGV unless $#ARGV == -1; my @return_list; for (@update_list) { push @return_list, $_ if not get_option($_, "manual-update"); } return @return_list; } # 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 = ) { $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 @ARGV unless $#ARGV == -1; my @list; for (@build_list) { push @list, $_ unless get_option($_, 'manual-update'); } return @list; } # 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); push @failed_list, $module; } # 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 the directory is admin we need to checkout instead of updating if # the directory didn't already exist. 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; # This form of split splits on whitespace, but doesn't give empty leading or # trailing fields. my @dirlist = split (' ', 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 explicitly asked for the given subdir on the command line. # If so, don't automatically add /admin, as that would simply be annoying. my $suppress_auto_admin = get_option($module, '#suppress-auto-admin'); # Check if the user specified the admin subdirectory. If not, # add it. push (@dirlist, 'admin') if not $suppress_auto_admin and 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 <>>\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"; if ($module eq 'kdebindings' or $module eq 'valgrind') { $script = get_build_dir($module) . "/$module/configure"; } } 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() { 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 ($module eq 'kdebindings' || $module eq 'valgrind') { # Use a slightly less method of builddir != srcdir for the module, # as it fails otherwise. chdir (get_build_dir($module) . "/$module"); if (log_command ($module, "lndir", [ "lndir", "$kdecvs/$module" ])) { print "\tUnable to setup special build system for $module.\n"; return 1; } } 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 ("$kdecvs/$module/inst-apps"); } my $cmd_ref = [ 'make', '-f', 'Makefile.cvs' ]; $cmd_ref = [ './autogen.sh' ] if $module eq 'valgrind'; if (log_command ($module, "build-system", $cmd_ref)) { 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 () { # 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; } } my $confpath = "$kdecvs/$module"; $confpath = get_build_dir($module) . "/$module" if $module eq 'kdebindings'; if ($do_makeconf or not -e "$confpath/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 ("PATH", "$kdecvs/kdenonbeta/unsermake:$ENV{PATH}"); # Try to remain compatible with older unsermake and /admin setenv ("UNSERMAKE", "$kdecvs/kdenonbeta/unsermake/unsermake"); } else { setenv ("UNSERMAKE", "no"); } # 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. The second and third paramaters is the ordinal number of the # module being built (1 == first module, 2 == second, etc.), and the total # number of modules being built respectively. # # Returns boolean false on failure, boolean true on success. sub build_module { my $module = shift; my $cur_module_num = shift; my $total_module_num = 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); if($module eq 'qt-copy' and "$builddir/$module" ne get_option('global', 'qtdir')) { print <{'#was-rebuilt'}) { print "Building $module ($cur_module_num/$total_module_num)\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 @modules = @{$build_ref}; 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; }; } my $num_modules = scalar @modules; my $i = 1; while ($module = shift @modules) { my $start_time = time; if (build_module ($module, $i, $num_modules)) { 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; $i++; } close STATUS_FILE; print "<<< BUILD DONE >>>\n"; print "\n<<< PACKAGES SUCCESSFULLY BUILT >>>\n" if scalar @build_done > 0; 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"); } output_failed_module_list ('failed building', @fail_list); 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; } if (pretending) { print "\tWould have installed $module\n"; next; } # Just in case, I guess. update_module_environment ($module); # safe_make() evilly uses the "install" parameter to use installation # mode instead of compile mode. This is so we can get the subdirectory # handling for free. if (safe_make ($module, "install")) { print "\tUnable to install $module!\n"; $result = 1; push @install_fail, $module; if (get_option($module, 'stop-on-failure')) { print "Stopping here.\n"; return 1; # Error } } } return $result; } # This subroutine goes and makes sure that any entries in the update and build # lists that have a directory separator are faked into using the checkout-only # feature. This doesn't really work for install mode though. sub munge_lists { print "Munging update and build list\n" if debugging; my $cleared = 0; for my $list_ref ( ( \@update_list, \@build_list) ) { my @temp; my %seen; while ($_ = shift @$list_ref) { # Split at directory separators. my ($modulename, @dirs) = split(/\//); if (scalar @dirs > 0) { # Only build the specified subdirs if (not $cleared) { print "Clearing checkout-only option.\n" if debugging; $cleared = 1; $package_opts{$modulename}{'checkout-only'} = ""; } # The user has included a directory separator in the module name, so # let's fake the cvs partial checkout $_ = $modulename; # Don't automatically add the /admin dir for this module now. $package_opts{$_}{'#suppress-auto-admin'} = 1; my $checkout_str = join ("/", @dirs); print "Adding $checkout_str to checkout-only for $_\n" if debugging; if (get_option($_, 'checkout-only') !~ /$checkout_str/) { $package_opts{$_}{'checkout-only'} .= " $checkout_str"; } else { print "\tOption was already present.\n" if debugging; } } else { print "Skipping $_ in munge process.\n" if debugging; } # Don't add the modulename to the list twice. Hashes are the easiest way in # Perl to do this. I'd love an "in" operator for lists. push @temp, $_ if not $seen{$_}; $seen{$_} = 1; } @$list_ref = @temp; } } # 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 "Update list is ", join (', ', @update_list), "\n" if debugging; print "Build list is ", join (', ', @build_list), "\n" if debugging; # Do some necessary adjusting. Right now this is used for supporting # the command-line option shortcut to where you can enter e.g. # kdelibs/khtml, and the script will only try to update that part of # the module. munge_lists(); # 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; output_failed_module_list ("failed to update", @failed_list); output_failed_module_list ("failed to install", @install_fail); } else { # Installation mode. $result = handle_install (get_install_list()); output_failed_module_list ("failed to install", @install_fail); } $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: