diff options
| author | Timothy Pearson <kb9vqf@pearsoncomputing.net> | 2011-11-16 16:06:07 -0600 |
|---|---|---|
| committer | Timothy Pearson <kb9vqf@pearsoncomputing.net> | 2011-11-16 16:06:07 -0600 |
| commit | 7362f9a32f45817fb533ef781b7605c44e430679 (patch) | |
| tree | e9650a1b9d37dd2ccfbe090d412180b4e0a6a4b5 /scripts/kdesvn-build | |
| parent | bd2cd480bd28aecc9111829e3b77a4f61798bed7 (diff) | |
| download | tdesdk-7362f9a32f45817fb533ef781b7605c44e430679.tar.gz tdesdk-7362f9a32f45817fb533ef781b7605c44e430679.zip | |
Finish rename from prior commit
Diffstat (limited to 'scripts/kdesvn-build')
| -rwxr-xr-x | scripts/kdesvn-build | 4286 |
1 files changed, 0 insertions, 4286 deletions
diff --git a/scripts/kdesvn-build b/scripts/kdesvn-build deleted file mode 100755 index fb81ac67..00000000 --- a/scripts/kdesvn-build +++ /dev/null @@ -1,4286 +0,0 @@ -#!/usr/bin/perl -w - -#Pod documentation: - -=head1 NAME - -=over - -=item B<tdesvn-build> - automate the kde svn build process - -=back - -=head1 SYNOPSIS - -=over - -=item B<tdesvn-build> I<[options]...> I<[modules]...> - -=back - -=head1 DESCRIPTION - -The B<tdesvn-build> script is used to automate the download, build, -and install process for KDE (using Subversion). - -It is recommended that you first setup a F<.tdesvn-buildrc> file -in your home directory. Please refer to B<tdesvn-build> help file -in KDE help for information on how to write F<.tdesvn-buildrc>, -or consult the sample file which should have been included -with this program. If you don't setup a F<.tdesvn-buildrc>, a -default set of options will be used, and a few modules will be -built by default. - -After setting up F<.tdesvn-buildrc>, you can run this program from -either the command-line or from cron. It will automatically -download the modules from Subversion, create the build -system, and configure and make the modules you tell it to. -You can use this program to install KDE as well, -if you are building KDE for a single user. Note that B<tdesvn-build> -will try to install the modules by default. - -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 F<.tdesvn-buildrc> - -tdesvn-build reads options in the following order: - -=over - -=item 1. From the command line. - -=item 2. From the file F<tdesvn-buildrc> in the current directory. Note that - the file is not a hidden file. - -=item 3. From the file F<~/.tdesvn-buildrc>. - -=item 4. From a set of internal options. - -=back - -This utility is part of the KDE Software Development Kit. - -=head1 OPTIONS - -=over - -=item B<--quiet>, B<-q> - -With this switch tdesvn-build will only output a general overview of the build -process. Progress output is still displayed if available. - -=item B<--really-quiet> - -With this switch only warnings and errors will be output. - -=item B<--verbose>, B<-v> - -Be very detailed in what is going on, and what actions tdesvn-build is taking. -Only B<--debug> is more detailed. - -=item B<--no-svn> - -Skip contacting the Subversion server. - -=item B<--no-build> - -Skip the build process. - -=item B<--no-install> - -Don't automatically install after build. - -=item B<--svn-only> - -Update from Subversion only (Identical to B<--no-build> at this point). - -=item B<--build-only> - -Build only, do not perform updates or install. - -=item B<--rc-file=E<lt>filenameE<gt>> - -Read configuration from filename instead of default. - -=item B<--debug> - -Activates debug mode. - -=item B<--pretend>, B<-p> - -Do not contact the Subversion server, run make, or create / delete files -and directories. Instead, output what the script would have done. - -=item B<--nice=E<lt>valueE<gt>> - -Allow you to run the script with a lower priority. The default value is -10 (lower priority by 10 steps). - -=item B<--prefix=/kde/path> - -This option is a shortcut to change the setting for kdedir from the -command line. It implies B<--reconfigure>. - -=item B<--color> - -Add color to the output. - -=item B<--no-color> - -Remove color from the output. - -=item B<--resume> - -Tries to resume the make process from the last time the script was run, -without performing the Subversion update. - -=item B<--resume-from=E<lt>pkgE<gt>> - -Starts building from the given package, without performing the Subversion -update. - -=item B<--revision=E<lt>revE<gt>>, B<-r=E<lt>revE<gt>> - -Forces update to revision <rev> from Subversion. - -=item B<--refresh-build> - -Start the build from scratch. This means that the build directory for the -module B<will be deleted> before make -f Makefile.cvs is run again. You can -use B<--recreate-configure> to do the same thing without deleting the module -build directory. - -=item B<--reconfigure> - -Run configure again, but don't clean the build directory or re-run -make -f Makefile.cvs. - -=item B<--recreate-configure> - -Run make -f Makefile.cvs again to redo the configure script. The build -directory is not deleted. - -=item B<--no-rebuild-on-fail> - -Do not try to rebuild a module from scratch if it failed building. Normally -tdesvn-build will try progressively harder to build the module before giving -up. - -=item B<--build-system-only> - -Create the build infrastructure, but don't actually perform the build. - -=item B<--install> - -Try to install the packages passed on the command line, or all packages in -F<~/.tdesvn-buildrc> that don't have manual-build set. Building and -Subversion updates are not performed. - -=item B<--E<lt>optionE<gt>=> - -Any unrecognized options are added to the global configuration, overriding -any value that may exist. - -For example, B<--svn-server=http://path.to.svn.server/> would change the -setting of the global B<svn-server> option for this instance of tdesvn-build. - -=item B<--E<lt>moduleE<gt>,E<lt>optionE<gt>=> - -Likewise, allow you to override any module specific option from the -command line. - -Example: B<--tdelibs,use-unsermake=false> would disable unsermake for the -tdelibs module. - -=item B<--help> - -Display the help and exit. - -=item B<--author> - -Output the author(s)'s name. - -=item B<--version> - -Output the program version. - -=back - -=head1 EXAMPLES - -=over - -=item B<tdesvn-build> - -=item B<tdesvn-build> I<--no-svn tdelibs> - -=item B<tdesvn-bulid> I<--refresh-build> I<tdebase> - -=back - -=head1 BUGS - -Since tdesvn-build doesn't generally save information related to the build and -prior settings, you may need to manually re-run tdesvn-build with a flag like -B<--recreate-configure> if you change some options, including B<use-unsermake>. - -Please use KDE bugzilla at http://bugs.kde.org for information and -reporting bugs. - -=head1 SEE ALSO - -You can find additional information at B<tdesvn-build> home page, -F<http://tdesvn-build.kde.org/>, or using tdesvn-build -docbook documentation, using the help kioslave, F<help:/tdesvn-build>. - -=head1 AUTHOR - -Michael Pyne <michael.pyne@kdemail.net> - -Man page written by: -Carlos Leonhard Woelz <carlos.woelz@kdemail.net> - -=cut - -# Script to handle building KDE from Subversion. All of the configuration is -# stored in the file ~/.tdesvn-buildrc. -# -# Please also see the documentation that should be included with this program, -# in doc.html -# -# Copyright (c) 2003, 2004, 2005 Michael Pyne. <michael.pyne@kdemail.net> -# Home page: http://tdesvn-build.kde.org/ -# -# You may use, alter, and redistribute this software under the terms -# of the GNU General Public License, v2 (or any later version). -# -# TODO: 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 'strftime'; -use File::Find; # For our lndir reimplementation. -use Errno qw(:POSIX); - -# Debugging level constants. -use constant { - DEBUG => 0, - WHISPER => 1, - INFO => 2, - NOTE => 3, - WARNING => 4, - ERROR => 5, -}; - -# 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 %package_opts = ( - 'global' => { - "apidox" => "", - "apply-qt-patches" => "", - "binpath" => "/bin:/usr/bin:/usr/X11R6/bin:/usr/local/bin", - "branch" => "", - "build-dir" => "build", - "build-system-only" => "", - "checkout-only" => "", - "configure-flags" => "--enable-debug", - "colorful-output" => 1, # Use color by default. - "cxxflags" => "-pipe", - "debug" => "", - "debug-level" => INFO, - "dest-dir" => '${MODULE}', # single quotes used on purpose! - "disable-agent-check" => 0, # If true we don't check on ssh-agent - "do-not-compile" => "", - "email-address" => "", - "email-on-compile-error" => "", - "install-after-build" => "1", # Default to true - "inst-apps" => "", - "kdedir" => "$ENV{HOME}/kde", - "libpath" => "", - "log-dir" => "log", - "make-install-prefix" => "", # Some people need sudo - "make-options" => "-j2", - "manual-build" => "", - "manual-update" => "", - "module-base-path" => "", # Used for tags and branches - "niceness" => "10", - "no-svn" => "", - "no-rebuild-on-fail" => "", - "override-url" => "", - "prefix" => "", # Override installation prefix. - "pretend" => "", - "qtdir" => "$ENV{HOME}/tdesvn/build/qt-copy", - "reconfigure" => "", - "recreate-configure" => "", - "refresh-build" => "", - "remove-after-install"=> "none", # { none, builddir, all } - "revision" => 0, - "set-env" => { }, # Hash of environment vars to set - "source-dir" => "$ENV{HOME}/tdesvn", - "stop-on-failure" => "", - "svn-server" => "svn://anonsvn.kde.org/home/kde", - "tag" => "", - "unsermake-options" => "--compile-jobs=2 -p", - "unsermake-path" => "unsermake", - "use-unsermake" => "1", # Default to true now, we may need a blacklist - } -); - -# This is a hash since Perl doesn't have a "in" keyword. -my %ignore_list; # List of packages to refuse to include in the build list. - -# update and build are lists since they support an ordering, which can't be -# guaranteed using a hash unless I want a custom sort function (which isn't -# necessarily a horrible way to go, I just chose to do it this way. -my @update_list; # List of modules to update/checkout. -my @build_list; # List of modules to build. - -# Dictionary of lists of failed modules, keyed by the name of the operation -# that caused the failure (e.g. build). Note that output_failed_module_lists -# uses the key name to display text to the user so it should describe the -# actual category of failure. You should also add the key name to -# output_failed_module_lists since it uses its own sorted list. -my @fail_display_order = qw/build update install/; -my %fail_lists = ( - 'build' => [ ], - 'install' => [ ], - 'update' => [ ], -); - -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 @rcfiles = ("./tdesvn-buildrc", "$ENV{HOME}/.tdesvn-buildrc"); -my $rcfile; # the file that was used; set by read_options - -# Colors -my ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = ("") x 5; - -# Subroutine definitions - -# I swear Perl must be the only language where the docs tell you to use a -# constant that you'll never find exported without some module from CPAN. -use constant PRIO_PROCESS => 0; - -# I'm lazy and would rather write in shorthand for the colors. This sub -# allows me to do so. Put it right up top to stifle Perl warnings. -sub clr($) -{ - my $str = shift; - - $str =~ s/g\[/$GREEN/g; - $str =~ s/]/$NORMAL/g; - $str =~ s/y\[/$YELLOW/g; - $str =~ s/r\[/$RED/g; - $str =~ s/b\[/$BOLD/g; - - return $str; -} - -# 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-level') <= DEBUG; -} - -# The next few subroutines are used to print output at different importance -# levels to allow for e.g. quiet switches, or verbose switches. The levels are, -# from least to most important: -# debug, whisper, info (default), note (quiet), warning (very-quiet), and error. -# -# You can also use the pretend output subroutine, which is emitted if, and only -# if pretend mode is enabled. -# -# clr is automatically run on the input for all of those functions. -# Also, the terminal color is automatically reset to normal as well so you don't -# need to manually add the ] to reset. - -# Subroutine used to actually display the data, calls clr on each entry first. -sub print_clr(@) -{ - print clr $_ foreach (@_); - print clr "]\n"; -} - -sub debug(@) -{ - print_clr @_ if debugging; -} - -sub whisper(@) -{ - print_clr @_ if get_option('global', 'debug-level') <= WHISPER; -} - -sub info(@) -{ - print_clr @_ if get_option('global', 'debug-level') <= INFO; -} - -sub note(@) -{ - print_clr @_ if get_option('global', 'debug-level') <= NOTE; -} - -sub warning(@) -{ - print_clr @_ if get_option('global', 'debug-level') <= WARNING; -} - -# This sub has the additional side effect of printing the errno value if it -# is set. -sub error(@) -{ - print STDERR (clr $_) foreach (@_); - print " $!\n" if $!; -} - -sub pretend(@) -{ - print_clr @_ if pretending; -} - -# Subroutine to handle removing the lock file upon receiving a signal -sub quit_handler -{ - note "Signal received, terminating."; - finish(5); -} - -# 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; - - debug "get_output_file in mode $mode"; - - 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"; - - debug "Old build status file is $fname"; - - # The _ at the end returns the cached file stats to avoid multiple - # stat() calls. - 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"; - debug "Build status file is $fname"; - - 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 $tdesvn. - my $tdesvndir = get_tdesvn_dir(); - $dir = "$tdesvndir/$dir"; - } - - return $dir; -} - -# Subroutine to return the name of the destination directory for the checkout -# and build routines. Based on the dest-dir option. The return value will be -# relative to the src/build dir. The user may use the '$MODULE' or '${MODULE}' -# sequences, which will be replaced by the name of the module in question. -# -# The first parameter should be the module name. -sub get_dest_dir -{ - my $module = shift; - my $dest_dir = get_option($module, 'dest-dir'); - - $dest_dir =~ s/(\${MODULE})|(\$MODULE\b)/$module/g; - - return $dest_dir; -} - -# Convienience subroutine to get the source root dir. -sub get_tdesvn_dir -{ - return get_option ('global', 'source-dir'); -} - -# Function to work around a Perl language limitation. -# First parameter is the list to search. -# Second parameter is the value to search for. -# Returns true if the value is in the list -sub list_has(\@$) -{ - my ($list_ref, $value) = @_; - return scalar grep ($_ eq $value, @{$list_ref}); -} - -# Subroutine to return the branch prefix. i.e. the part before the branch name -# and module name. -# -# The first parameter is the module in question. -# The second parameter should be 'branches' if we're dealing with a branch or -# 'tags' if we're dealing with a tag. -# -# Ex: 'tdelibs' => 'branches/KDE' -# 'tdevelop' => 'branches/tdevelop' -sub branch_prefix -{ - my $module = shift; - my $type = shift; - - # These modules seem to have their own subdir in /tags. - my @tag_components = qw/arts koffice amarok kst qt taglib/; - - # The map call adds the kde prefix to the module names because I don't feel - # like typing them all in. tdevelop and konstruct are special cases. - my @kde_module_list = ((map {'kde' . $_} qw/-i18n -common accessibility - addons admin artwork base bindings edu games graphics libs - multimedia network nonbeta pim sdk toys utils webdev/), 'tdevelop', - 'konstruct'); - - # KDE proper modules seem to use this pattern. - return "$type/KDE" if list_has(@kde_module_list, $module); - - # If we doing a tag just return 'tags' because the next part is the actual - # tag name, which is added by the caller, unless the module has its own - # subdirectory in /tags. - return "$type" if $type eq 'tags' and not list_has(@tag_components, $module); - - # Everything else. - return "$type/$module"; -} - -# Subroutine to return a module URL for a module using the 'branch' option. -# First parameter is the module in question. -# Second parameter is the type ('tags' or 'branches') -sub handle_branch_tag_option -{ - my ($module, $type) = @_; - my $svn_server = get_option($module, 'svn-server'); - my $branch = branch_prefix($module, $type); - my $branchname = get_option($module, 'tag'); - - if($type eq 'branches') - { - $branchname = get_option($module, 'branch'); - } - - # Remove trailing slashes. - $svn_server =~ s/\/*$//; - - return "$svn_server/$branch/$branchname/$module"; -} - -# Subroutine to return the appropriate SVN URL for a given module, based on -# the user settings. For example, 'tdelibs' -> https://svn.kde.org/home/kde/trunk/KDE/tdelibs -sub svn_module_url -{ - my $module = shift; - my $svn_server = get_option($module, 'svn-server'); - my $branch = get_option($module, 'module-base-path'); - - # Allow user to override normal processing of the module in a few ways, - # to make it easier to still be able to use tdesvn-build even when I - # can't be there to manually update every little special case. - if(get_option($module, 'override-url')) - { - return get_option($module, 'override-url'); - } - - if(get_option($module, 'tag')) - { - return handle_branch_tag_option($module, 'tags'); - } - - if(get_option($module, 'branch')) - { - return handle_branch_tag_option($module, 'branches'); - } - - # The following modules are in /trunk, not /trunk/KDE. There are others, - # but there are the important ones. The hash is associated with the value - # 1 so that we can do a boolean test by looking up the module name. - my @non_trunk_modules = qw(extragear kdenonbeta tdesupport koffice - playground qt-copy valgrind KDE kdereview www l10n); - - my $module_root = $module; - $module_root =~ s/\/.*//; # Remove everything after the first slash - - if (not $branch) - { - $branch = 'trunk/KDE'; - $branch = 'trunk' if list_has(@non_trunk_modules, $module_root); - } - - $branch =~ s/^\/*//; # Eliminate / at beginning of string. - $branch =~ s/\/*$//; # Likewise at the end. - - # Remove trailing slashes. - $svn_server =~ s/\/*$//; - - return "$svn_server/$branch/$module"; -} - -# 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. -# TODO: From what I hear this hack is no longer necessary. Investigate this. -sub get_build_dir -{ - my $module = shift; - - # It is the responsibility of the caller to append $module! - return get_tdesvn_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; - - # A hash is used to track directories to avoid duplicate entries. - unshift @module_list, "global"; - $log_dict{get_subdir_path($_, 'log-dir')} = 1 foreach @module_list; - - debug "Log directories are ", join (", ", keys %log_dict); - 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; -} - -# 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'; - - debug "Log directory for $module is $logpath"; - - if (not -e $logpath and not pretending and not super_mkdir($logpath)) - { - error "Unable to create log directory r[$logpath]"; - return undef; - } - - # Add symlink to the directory. - # TODO: This probably can result in a few dozen unnecessary calls to - # unlink and symlink, fix this. - if (not pretending) - { - unlink("$logbase/latest") if -l "$logbase/latest"; - symlink("$logbase/$LOG_DATE-$BUILD_ID", "$logbase/latest"); - } - - return $logpath; -} - -# This function returns true if the given option doesn't make sense with the -# given module. -# blacklisted($module, $option) -sub blacklisted -{ - my ($module, $option) = @_; - - # Known to not work. - my @unsermake_ban_list = qw/valgrind kde-common qt-copy tdebindings/; - - return list_has(@unsermake_ban_list, $module) if ($option eq 'use-unsermake'); - return 0; -} - -# 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; - my $global_opts = $package_opts{'global'}; - my $defaultQtCopyArgs = '-qt-gif -plugin-imgfmt-mng -thread -no-exceptions -debug -dlopen-opengl -plugin-sql-sqlite'; - my @lockedOpts = qw(source-dir svn-server qtdir libpath binpath kdedir - pretend disable-agent-check); - - # These options can't override globals - if (list_has(@lockedOpts, $option) or $module eq 'global') - { - return ${$global_opts}{"#$option"} if exists ${$global_opts}{"#$option"}; - return ${$global_opts}{$option}; - } - - # Don't even try this - return 0 if blacklisted($module, $option); - - my $ref = $package_opts{$module}; - - # Check for a sticky option - return $$ref{"#$option"} if exists $$ref{"#$option"}; - - # Next in order of precedence - if (defined ${$global_opts}{"#$option"} and not - ($module eq 'qt-copy' and $option eq 'configure-flags')) - { - return ${$global_opts}{"#$option"}; - } - - # No sticky options left. - # 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(defined $$ref{$option}) - { - my $modvalue = $$ref{$option}; - $value .= " $modvalue"; - } - - return $value; - } - - # As always qt-copy has to be difficult - if ($module eq 'qt-copy' and $option eq 'configure-flags') - { - return $defaultQtCopyArgs if not defined $$ref{$option}; - return $$ref{$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. - return $$ref{$option} if defined $$ref{$option}; - return ${$global_opts}{$option}; -} - -# Subroutine used to handle the checkout-only option. It handles -# updating subdirectories of an already-checked-out module. -# First parameter is the module, all remaining parameters are subdirectories -# to check out. -# -# Returns 0 on success, non-zero on failure. -sub update_module_subdirectories -{ - my $module = shift; - my $result; - - # If we have elements in @path, download them now - for my $dir (@_) - { - info "\tUpdating g[$dir]"; - $result = run_svn($module, "svn-up-$dir", [ 'svn', 'up', $dir ]); - return $result if $result; - } - - return 0; -} - -# Returns true if a module has a base component to their name (e.g. KDE/, -# extragear/, or playground). Note that modules that aren't in trunk/KDE -# don't necessary meet this criteria (e.g. kdereview is a module itself). -sub has_base_module -{ - my $module = shift; - - return $module =~ /^(extragear|playground|KDE)(\/[^\/]+)?$/; -} - -# Subroutine to return the directory that a module will be stored in. -# NOTE: The return value is a hash. The key 'module' will return the final -# module name, the key 'path' will return the full path to the module. The -# key 'fullpath' will return their concatenation. -# For example, with $module == 'KDE/tdelibs', and no change in the dest-dir -# option, you'd get something like: -# { -# 'path' => '/home/user/tdesvn/KDE', -# 'module' => 'tdelibs', -# 'fullpath' => '/home/user/tdesvn/KDE/tdelibs' -# } -# If dest-dir were changed to e.g. extragear-multimedia, you'd get: -# { -# 'path' => '/home/user/tdesvn', -# 'module' => 'extragear-multimedia', -# 'fullpath' => '/home/user/tdesvn/extragear-multimedia' -# } -# First parameter is the module. -# Second parameter is either source or build. -sub get_module_path_dir -{ - my $module = shift; - my $type = shift; - my $destdir = get_dest_dir($module); - my $srcbase = get_tdesvn_dir(); - $srcbase = get_build_dir($module) if $type eq 'build'; - - my $combined = "$srcbase/$destdir"; - - # Remove dup // - $combined =~ s/\/+/\//; - - my @parts = split(/\//, $combined); - my %result = (); - $result{'module'} = pop @parts; - $result{'path'} = join('/', @parts); - $result{'fullpath'} = "$result{path}/$result{module}"; - - return %result; -} - -sub get_fullpath -{ - my ($module, $type) = @_; - my %pathinfo = get_module_path_dir($module, $type); - - return $pathinfo{'fullpath'}; -} - -# Checkout a module that has not been checked out before, along with any -# subdirectories the user desires. -# The first parameter is the module to checkout (including extragear and -# playground modules), all remaining parameters are subdirectories of the -# module to checkout. -# Returns 0 on success, non-zero on failure. -sub checkout_module_path -{ - my ($module, @path) = @_; - my %pathinfo = get_module_path_dir($module, 'source'); - my $result; - my @args; - - if (not -e $pathinfo{'path'} and not super_mkdir($pathinfo{'path'})) - { - error "Unable to create path r[$pathinfo{path}]!"; - return 1; - } - - chdir($pathinfo{'path'}); - - push @args, ('svn', 'co'); - push @args, '-N' if scalar @path; - push @args, svn_module_url($module); - push @args, $pathinfo{'module'}; - - note "Checking out g[$module]"; - $result = run_svn($module, 'svn-co', \@args); - return $result if $result; - - chdir($pathinfo{'module'}) if scalar @path; - - return update_module_subdirectories($module, @path); -} - -# Update a module that has already been checked out, along with any -# subdirectories the user desires. -# The first parameter is the module to checkout (including extragear and -# playground modules), all remaining parameters are subdirectories of the -# module to checkout. -# Returns 0 on success, non-zero on failure. -sub update_module_path -{ - my ($module, @path) = @_; - my $fullpath = get_fullpath($module, 'source'); - my $result; - my @args; - - chdir $fullpath; - - push @args, ('svn', 'up'); - push @args, '-N' if scalar @path; - - note "Updating g[$module]"; - - $result = run_svn($module, 'svn-up', \@args); - - if($result) # Update failed, try svn cleanup. - { - info "\tUpdate failed, trying a cleanup."; - $result = safe_system('svn', 'cleanup'); - - return $result if $result; - - info "\tCleanup complete."; - # Now try again. - - $result = run_svn($module, 'svn-up-2', \@args); - } - - return $result if $result; - - # If the admin dir exists and is a soft link, remove it so that svn can - # update it if need be. The link will automatically be re-created later - # in the process if necessary by the build functions. - unlink ("$fullpath/admin") if -l "$fullpath/admin"; - - return update_module_subdirectories($module, @path); -} - -# 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); - - debug "log_command(): Module $module, Command: ", join(' ', @command); - - if (pretending) - { - pretend "\tWould have run g[", join (' ', @command); - 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. - my $result = $?; - set_error_logfile($module, "$filename.log") if $result; - - # If we are using the alias to a tdesvn-build function, it should have - # already printed the error message, so clear out errno (but still - # return failure status). - if ($command[0] eq 'tdesvn-build') - { - $! = 0; - } - - return $result; - } - else - { - # Child - if (not defined $logdir or not -e $logdir) - { - # Error creating directory for some reason. - error "\tLogging to std out due to failure creating log dir."; - } - - # Redirect stdout and stderr to the given file. - if (not debugging) - { -# Comment this out because it conflicts with make-install-prefix -# open (STDIN, "</dev/null"); - open (STDOUT, ">$logdir/$filename.log") or do { - error "Error opening $logdir/$filename.log for logfile."; - # Don't abort, hopefully STDOUT still works. - }; - } - else - { - open (STDOUT, "|tee $logdir/$filename.log") or do { - error "Error opening pipe to tee command."; - # Don't abort, hopefully STDOUT still works. - }; - } - - # Make sure we log everything. If the command is svn, it is possible - # that the client will produce output trying to get a password, so - # don't redirect stderr in that case. - open (STDERR, ">&STDOUT") unless $command[0] eq 'svn'; - - # Call internal function, name given by $command[1] - if($command[0] eq 'tdesvn-build') - { - debug "Calling $command[1]"; - - my $cmd = $command[1]; - splice (@command, 0, 2); # Remove first two elements. - - no strict 'refs'; # Disable restriction on symbolic subroutines. - if (not &{$cmd}(@command)) # Call sub - { - exit EINVAL; - } - - exit 0; - } - - # External command. - exec (@command) or do { - my $cmd_string = join(' ', @command); - error <<EOF; -r[b[Unable to execute "$cmd_string"]! - $! - -Please check your binpath setting (it controls the PATH used by tdesvn-build). -Currently it is set to g[$ENV{PATH}]. -EOF - # Don't use return, this is the child still! - exit 1; - }; - } -} - -# Subroutine to mark a file as being the error log for a module. This also -# creates a symlink in the module log directory for easy viewing. -# First parameter is the module in question. -# Second parameter is the filename in the log directory of the error log. -sub set_error_logfile -{ - my ($module, $logfile) = @_; - my $logdir = get_log_dir($module); - - return unless $logfile; - - set_option($module, '#error-log-file', "$logdir/$logfile"); - - # Setup symlink in the module log directory pointing to the appropriate - # file. Make sure to remove it first if it already exists. - unlink("$logdir/error.log") if -l "$logdir/error.log"; - - if(-e "$logdir/error.log") - { - # Maybe it was a regular file? - error "r[b[ * Unable to create symlink to error log file]"; - return 0; - } - - symlink "$logdir/$logfile", "$logdir/error.log"; -} - -# Subroutine to run make/unsermake with redirected STDOUT and STDERR, -# and to process the percentage in unsermake (-p). 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. -# -# TODO: This is a fork of log_command(). Find a way to re-merge them. -# Returns 0 on success, non-zero on failure. -sub run_make_command -{ - my $pid; - my $module = shift; - my $filename = shift; - my @command = @{(shift)}; - my $logdir = get_log_dir($module); - my $isunsermake = $command[0] =~ 'unsermake'; - - # Don't print ANSI characters if we're not on a tty. Also, automake - # doesn't support printing output status. Finally, we output the whole - # log to screen when debugging which makes this useless. - if (!$isunsermake or not -t STDERR or debugging) - { - return log_command($module, $filename, \@command); - } - - # Make sure -p is in the unsermake flags, it's the whole reason for using - # this function. - if (!(grep /^(-p)|(--print-progress)$/, @command)) - { - # Add in front of element 1, deleting 0 elements. - splice @command, 1, 0, '-p'; - } - - if (pretending) - { - pretend "\tWould have run g[", join (' ', @command); - return 0; - } - - $pid = open(CHILD, '-|'); - if ($pid) - { - my $last = -1; - - while (<CHILD>) - { - chomp; - - # Update terminal (\e[K clears the line) if the percentage - # changed. - if (/([0-9]+)% (creating|compiling|linking)/) - { - print STDERR "\r$1% \e[K" unless ($1 == $last); - $last = $1; - } - } - - close(CHILD); - print STDERR "\r\e[K"; - - # If the module fails building, set an internal flag in the module - # options with the name of the log file containing the error message. - my $result = $?; - set_error_logfile($module, "$filename.log") if $result; - - return $result; - } - else - { - # Child - if (not defined $logdir or not -e $logdir) - { - # Error creating directory for some reason. - error "\tLogging to standard output due to failure creating log dir."; - } - - open (STDOUT, "|tee $logdir/$filename.log") or do { - error "Error opening pipe to tee command." - }; - - # Make sure we log everything. - open (STDERR, ">&STDOUT"); - - exec (@command) or do { - my $cmd_string = join(' ', @command); - error <<EOF; -r[b[Unable to execute "$cmd_string"]! - $! - -Please check your binpath setting (it controls the PATH used by tdesvn-build). -Currently it is set to g[$ENV{PATH}]. -EOF - # Don't return, we're still in the child! - exit 1; - }; - } -} - -# Subroutine to determine if the given subdirectory of a module can actually be -# built or not. For instance, /admin can never be built, and the /kalyptus subdir -# of tdebindings can't either. -sub is_subdir_buildable -{ - my ($module, $dir) = @_; - - return 0 if $dir eq 'admin'; - return 0 if $dir eq 'kalyptus' and $module eq 'tdebindings'; - return 1; -} - -# Subroutine to return the path to the given executable based on the current -# binpath settings. e.g. if you pass make you could get '/usr/bin/make'. If -# the executable is not found undef is returned. -# -# This assumes that the module environment has already been updated since -# binpath doesn't exactly correspond to $ENV{'PATH'}. -sub path_to_prog -{ - my $prog = shift; - my @paths = split(/:/, $ENV{'PATH'}); - - # If it starts with a / the path is already absolute. - return $prog if $prog =~ /^\//; - - for my $path (@paths) - { - return "$path/$prog" if (-x "$path/$prog"); - } - - return undef; -} - -# 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, $trynumber, $apidox, @args) = @_; - my $opts; - 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'; - - if (get_option($module, 'use-unsermake')) - { - $make = get_option('global', 'unsermake-path'); - $opts = get_option($module, 'unsermake-options'); - } - else - { - $opts = get_option($module, 'make-options'); - } - - # Convert the path to an absolute path since I've encountered a sudo that - # is apparently unable to guess. Maybe it's better that it doesn't guess - # anyways from a security point-of-view. - $make = path_to_prog($make) unless pretending; - - if(not defined $make) - { - # Weird, we can't find make, you'd think configure would have - # noticed... - error " r[b[*] Unable to find the g[make] executable!"; - - # Make sure we don't bother trying again, this is a more serious - # error. - set_option($module, "#was-rebuilt", 1); - return 1; - } - - # 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 (@args, split(' ', $opts)) unless $installing; - - my $description; - - # Check if we're installing - if($installing) - { - debug "Prepending install options, apidox: $apidox."; - - $description = $apidox ? "API Documentation" : clr "g[$module]"; - unshift @args, $make, $apidox ? 'install-apidox' : 'install'; - unshift @args, split(' ', get_option ($module, 'make-install-prefix')); - - info "\tInstalling $description."; - } - else - { - $description = "Building API Documentation"; - $description = "Compiling, attempt $trynumber" unless $apidox; - - push @args, 'apidox' if $apidox; - unshift @args, $make; - - info "\t$description..."; - } - - push (@dirs, "") if scalar @dirs == 0; - for my $subdir (@dirs) - { - # Some subdirectories shouldn't have make run within them. - next unless is_subdir_buildable($module, $subdir); - - my $logname = "build-$trynumber"; - if ($installing) - { - $logname = $apidox ? 'install-apidox' : 'install'; - } - - if ($subdir ne '') - { - $logname = $installing ? "install-$subdir" : "build-$subdir-$trynumber"; - next if $apidox; # Don't built apidox in a subdirectory - - info $installing ? "\tInstalling " : "\tBuilding ", "subdirectory g[$subdir]"; - } - - my %pathinfo = get_module_path_dir($module, 'build'); - my $builddir = "$pathinfo{fullpath}/$subdir"; - $builddir =~ s/\/*$//; - - chdir ($builddir); - - my $result = run_make_command ($module, $logname, \@args ); - 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, $val) = @_; - - return unless $val; - - pretend "\tWould have set g[$var]=y[$val]."; - - $ENV{$var} = $val; -} - -# Display a message to the user regarding their relative lack of -# ~/.tdesvn-buildrc, and point them to some help. We will continue using a -# default set of options. -sub no_config_whine -{ - my $searched = join("\n ", @rcfiles); - my $homepage = "http://tdesvn-build.kde.org/"; - - note <<"HOME"; -Unable to open configuration file! -We looked for: - $searched - -tdesvn-build will continue using a default set of options. These options may -not apply to you, so feel free to visit the tdesvn-build homepage - -b[g[$homepage] - -and use the configuration file generator to guide you through the process of -creating a config file to customize your tdesvn-build process. - -HOME -} - -# This subroutine assigns the appropriate options to %package_opts and the -# update and build lists to build a default set of modules. -sub setup_default_modules() -{ - @update_list = qw(qt-copy arts tdesupport tdelibs tdebase tdeartwork - tdemultimedia tdepim tdeutils tdegraphics tdegames - tdetoys tdeedu tdeaddons); - @build_list = @update_list; - - for my $i (@update_list) { - if (not exists $package_opts{$i}) - { - $package_opts{$i} = { }; # Set up defaults - $package_opts{$i}{'set-env'} = { }; - } - } - - # Setup default options for qt-copy - $package_opts{'qt-copy'} = { - 'conf-flags' => q(-system-zlib -qt-gif -system-libjpeg -system-libpng - -plugin-imgfmt-mng -thread -no-exceptions -debug - -dlopen-opengl), - 'apply-qt-patches' => 'true', - -# See setup_trinity5_hack() for why this option is here. - 'module-base-path' => 'branches/qt/3.3', - - 'use-qt-builddir-hack' => 'true', - 'use-unsermake' => 0, - 'set-env' => { }, - }; - - # That handy q() construct above kept the newlines, I don't want them. - $package_opts{'qt-copy'}{'conf-flags'} =~ s/\s+/ /gm; -} - -# Reads in the options from the config file and adds them to the option store. -# The first parameter is a reference to the file handle to read from. -# The second parameter is 'global' if we're reading the global section, or -# 'module' if we should expect an end module statement. -sub parse_module -{ - my ($fh, $module) = @_; - $module = 'global' unless $module; - - # Make sure we acknowledge that we read the module name in from the - # file. - if (not defined $package_opts{$module}) - { - $package_opts{$module} = { - 'set-env' => { } - }; - } - - # Read in each option - while (<$fh>) - { - # Handle line continuation - chomp; - - if(s/\\\s*$//) # Replace \ followed by optional space at EOL and try again. - { - $_ .= <$fh>; - redo unless eof($fh); - } - - s/#.*$//; # Remove comments - next if /^\s*$/; # Skip blank lines - - if($module eq 'global') - { - last if /^end\s+global/; # Stop - } - else - { - last if /^end\s+module/; # 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. - my ($option, $value) = /^\s* # Find all spaces - ([-\w]+) # First match, alphanumeric, -, and _ - # (?: ) means non-capturing group, so (.*) is $value - # So, skip spaces and pick up the rest of the line. - (?:\s+(.*))?$/x; - - $value = "" unless defined $value; - - # Simplify this. - $value =~ s/\s+$//; - $value =~ s/^\s+//; - $value =~ s/\s+/ /; - - # Check for false keyword and convert it to Perl false. - $value = 0 if lc($value) =~ /^false$/; - - # Replace tildes with home directory. - 1 while ($value =~ s"(^|:|=)~/"$1$ENV{'HOME'}/"); - - set_option($module, $option, $value); - } -} - -# This subroutine reads in the settings from the user's configuration -# file. -sub read_options -{ - # The options are stored in the file $rcfile - my $success = 0; - my $global_opts = $package_opts{'global'}; - for my $file (@rcfiles) - { - if (open CONFIG, "<$file") - { - $success = 1; - $rcfile = $file; - last; - } - } - - if (not $success) - { - if(scalar @rcfiles == 1) - { - # This can only happen if the user uses --rc-file, if we fail to - # load the file, we need to fail to load. - error <<EOM; -Unable to open config file $rcfiles[0] - -Script stopping here since you specified --rc-file on the command line to -load $rcfiles[0] manually. If you wish to run the script with no configuration -file, leave the --rc-file option out of the command line. - -EOM - exit 1; - } - - no_config_whine(); - setup_default_modules(); - return; - } - - my ($option, $flags, $modulename); - - # FIXME: Make global settings optional if only tweaks needed are for - # modules. - - # Read in global settings - while (<CONFIG>) - { - s/#.*$//; # Remove comments - next if (/^\s*$/); # Skip blank lines - - # First command in .tdesvn-buildrc should be a global - # options declaration, even if none are defined. - if (not /^global\s*$/) - { - error "Invalid configuration file: $rcfile."; - error "Expecting global settings section!"; - exit 1; - } - - # Now read in each global option - parse_module(\*CONFIG, 'global'); - last; - } - - my $using_default = 1; - - # Now read in module settings - while (<CONFIG>) - { - s/#.*$//; # Remove comments - next if (/^\s*$/); # Skip blank lines - - # Get modulename (has dash, dots, slashes, or letters/numbers) - ($modulename) = /^module\s+([-\/\.\w]+)\s*$/; - - if (not $modulename) - { - warning "Invalid configuration file $rcfile!"; - warning "Expecting a start of module section."; - warning "Global settings will be retained."; - - $modulename = 'null'; # Keep reading the module section though. - } - - # Don't build default modules if user has their own wishes. - if ($using_default) - { - $using_default = 0; - @update_list = @build_list = ( ); - } - - parse_module(\*CONFIG, $modulename); - - next if ($modulename eq 'null'); - - # 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; - - delete $package_opts{'null'}; # Just in case. - - # For the 3.5 edition we want to set the qt-copy option module-base-path - # to branches/qt/3.3 unless the user already has it set. - unless (exists $package_opts{'qt-copy'}{'module-base-path'}) - { - set_option ('qt-copy', 'module-base-path', 'branches/qt/3.3'); - } - - # If the user doesn't ask to build any modules, build a default set. - # The good question is what exactly should be built, but oh well. - setup_default_modules() if $using_default; -} - -# Subroutine to check if the given module needs special treatment to support -# srcdir != builddir. If this function returns true tdesvn-build will use a -# few hacks to simulate it, and will update e.g. configure paths appropriately -# as well. -sub module_needs_builddir_help -{ - my $module = shift; - my @module_help_list = qw/qt-copy tdebindings valgrind/; - - # qt-copy special case to support use-qt-builddir-hack. - if ($module eq 'qt-copy' and not get_option('qt-copy', 'use-qt-builddir-hack')) - { - return 0; - } - - return list_has(@module_help_list, $module); -} - -# 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}) - { - setenv($key, $value); - } -} - -# Subroutine to initialize some environment variable for building -# KDE from Subversion. 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 $svnserver = get_option ('global', 'svn-server'); - - my $pc_path = get_option('global', 'kdedir') . "/lib/pkgconfig"; - $pc_path .= ":" . $ENV{'PKG_CONFIG_PATH'} if ( exists $ENV{'PKG_CONFIG_PATH'} ); - $ENV{'PKG_CONFIG_PATH'} = $pc_path; - - if(-t STDOUT and get_option('global', 'colorful-output')) - { - $RED = "\e[31m"; - $GREEN = "\e[32m"; - $YELLOW = "\e[33m"; - $NORMAL = "\e[0m"; - $BOLD = "\e[1m"; - } - - # Set the process priority - setpriority PRIO_PROCESS, 0, get_option('global', 'niceness'); - - 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 $logdir/latest/build-status - my $logdir = get_subdir_path('global', 'log-dir'); - - if (not open BUILTLIST, "<$logdir/latest/build-status") - { - error "Can't determine what modules have built. You must"; - error "specify explicitly on the command line what modules to build."; - exit (1); # Don't finish, no lock has been taken. - } - - while (<BUILTLIST>) - { - chomp; - if (/Succeeded/) - { - # Clip to everything before the first colon. - my $module = (split(/:/))[0]; - push @install_list, $module; - } - } - - 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 - - debug "Message is $message"; - debug "\tfor ", join(', ', @fail_list); - - if (scalar @fail_list > 0) - { - my $homedir = $ENV{'HOME'}; - my $logfile; - - warning "\nr[b[<<< PACKAGES $message >>>]"; - - for (@fail_list) - { - $logfile = get_option($_, '#error-log-file'); - $logfile = "No log file" unless $logfile; - $logfile =~ s|$homedir|~|; - - warning "r[$_] - g[$logfile]"; - } - } -} - -# This subroutine reads the fail_lists dictionary to automatically call -# output_failed_module_list for all the module failures in one function -# call. -sub output_failed_module_lists() -{ - for my $type (@fail_display_order) - { - my @failures = @{$fail_lists{$type}}; - output_failed_module_list("failed to $type", @failures); - } -} - -# This subroutine extract the value from options of the form --option=value, -# which can also be expressed as --option value. The first parameter is the -# option that the user passed to the cmd line (e.g. --prefix=/opt/foo), and -# the second parameter is a reference to the list of command line options. -# The return value is the value of the option (the list might be shorter by -# 1, copy it if you don't want it to change), or undef if no value was -# provided. -sub extract_option_value($\@) -{ - my ($option, $options_ref) = @_; - - if ($option =~ /=/) - { - my @value = split(/=/, $option); - shift @value; # We don't need the first one, that the --option part. - - return undef if (scalar @value == 0); - - # If we have more than one element left in @value it's because the - # option itself has an = in it, make sure it goes back in the answer. - return join('=', @value); - } - - return undef if scalar @{$options_ref} == 0; - return shift @{$options_ref}; -} - -# Utility subroutine to handle setting the environment variable type of value. -# Returns true (non-zero) if this subroutine handled everything, 0 otherwise. -# The first parameter should by the reference to the hash with the 'set-env' -# hash ref, second parameter is the exact option to check, and the third -# option is the value to set that option to. -sub handle_set_env -{ - my ($href, $option, $value) = @_; - - return 0 if $option !~ /^#?set-env$/; - - my ($var, @values) = split(' ', $value); - - $$href{$option} = ( ) unless exists $$href{$option}; - $$href{$option}{$var} = join(' ', @values); - - return 1; -} - -# Sets the option for the given module to the given value. If the data for the -# module doesn't exist yet, it will be defined starting with a default value. -# First parameter: module to set option for (or 'global') -# Second parameter: option name (Preceded by # for a sticky option) -# Third parameter: option value -# Return value is void -sub set_option -{ - my ($module, $option, $value) = @_; - - # Set module options - if (not exists $package_opts{$module}) - { - $package_opts{$module} = { - 'set-env' => { } - }; - } - - return if handle_set_env($package_opts{$module}, $option, $value); - $package_opts{$module}{$option} = $value; -} - -# 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 $version = "tdesvn-build 0.97.6 (KDE 3.5 Edition)"; - my $author = <<DONE; -$version was written (mostly) by: - Michael Pyne <michael.pyne\@kdemail.net> - -Many people have contributed code, bugfixes, and documentation. - -Please report bugs using the KDE Bugzilla, at http://bugs.kde.org/ -DONE - - my @argv; - - while ($_ = shift @ARGV) - { - SWITCH: { - /^(--version)$/ && do { print "$version\n"; exit; }; - /^--author$/ && do { print $author; exit; }; - /^(-h)|(--?help)$/ && do { - print <<DONE; -$version - -This script automates the download, build, and install process for KDE (using -Subversion). - -It is recommended that you first setup a .tdesvn-buildrc file in your home -directory. Please visit http://tdesvn-build.kde.org/ for -information on how to write the file, or consult the sample file which should -have been included with this program. If you don't setup a .tdesvn-buildrc, -a default set of options will be used, which a few modules to be built by -default. - -After setting up .tdesvn-buildrc, you can run this program from either the -command-line or from cron. It will automatically download the modules from -Subversion, create the build system, and configure and make the modules you -tell it to. If you\'d like, you can use this program to install KDE as well, -if you\'re building KDE for a single user. Note that tdesvn-build will try -by default to install the modules. - -Basic synopsis, after setting up .tdesvn-buildrc: -\$ tdesvn-build [package names] (Download, build, and install KDE) - -If you don\'t specify any particular package names, then your settings -in .tdesvn-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 .tdesvn-buildrc - -Copyright (c) 2003, 2004, 2005 $author -The script is distributed under the terms of the GNU General Public License -v2, and includes ABSOLUTELY NO WARRANTY!!! - -Options: - --no-svn Skip contacting the Subversion server. - --no-build Skip the build process. - --no-install Don't automatically install after build. - - --svn-only Update from Subversion only (Identical to --no-build - at this point). - --build-only Build only, don't perform updates or install. - - --pretend (or -p) Don't actually contact the Subversion server, run make, - or create/delete files and directories. Instead, - output what the script would have done. - --quiet (or -q) Be less descriptive of the build process, without - printing each little substep tdesvn-build is - performing. - --really-quiet Only warnings and errors will be displayed. - --verbose (or -v) Be *very* descriptive of the build process. Only - --debug outputs more. - --debug Activates debug mode. - --color - --no-color Add (or remove) color from the output. - - --rc-file=<filename> Read configuration from filename instead of default. - --nice=<value> Allows you to run the script with a lower priority - The default value is 10 (lower priority by 10 steps). - --prefix=/kde/path This option is a shortcut to change the setting for - kdedir from the command line. It implies - --reconfigure. - - --resume Tries to resume the make process from the last time - the script was run, without performing the Subversion - update. - --resume-from=<pkg> Starts building from the given package, without - performing the Subversion update. - --revision (or -r)=<rev> Forces update to revision <rev> from Subversion. - - --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 ~/.tdesvn-buildrc that don't - have manual-build set. Building and Subversion - updates are not performed. - - --<option>= Any unrecognized options are added to the global - configuration, overriding any value that may exist. - --<module>,<option>= Likewise, this allows you to override any module - specific option from the command line. - - --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://tdesvn-build.kde.org/ -DONE - # We haven't done any locking... no need to finish() - # Avoids log-dir errors due to having not performed. - # read_options() and setup_logging_subsystem(). - exit 0; - }; - - /^--install$/ && do { - $install_flag = 1; - last SWITCH; - }; - - /^--no-svn$/ && do { - set_option('global', '#no-svn', 1); - last SWITCH; - }; - - /^--no-install$/ && do { - set_option('global', '#install-after-build', 0); - last SWITCH; - }; - - /^(-v)|(--verbose)$/ && do { - set_option('global', '#debug-level', WHISPER); - last SWITCH; - }; - - /^(-q)|(--quiet)$/ && do { - set_option('global', '#debug-level', NOTE); - last SWITCH; - }; - - /^--really-quiet$/ && do { - set_option('global', '#debug-level', WARNING); - last SWITCH; - }; - - /^--debug$/ && do { - set_option('global', 'debug-level', DEBUG); - last SWITCH; - }; - - /^--reconfigure$/ && do { - set_option('global', '#reconfigure', 1); - last SWITCH; - }; - - /^--recreate-configure$/ && do { - set_option('global', '#recreate-configure', 1); - last SWITCH; - }; - - /^--color$/ && do { - set_option('global', '#colorful-output', 1); - last SWITCH; - }; - - /^--no-color$/ && do { - set_option('global', '#colorful-output', 0); - last SWITCH; - }; - - /^--no-build$/ && do { - set_option('global', '#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. - /^--svn-only$/ && do { # Identically to --no-build - set_option('global', '#manual-build', 1); - last SWITCH; - }; - - # Don't run Subversion or install - /^--build-only$/ && do { - set_option('global', '#no-svn', 1); - set_option('global', '#install-after-build', 0); - last SWITCH; - }; - - /^--build-system-only$/ && do { - set_option('global', '#build-system-only', 1); - last SWITCH; - }; - - /^--rc-file=?/ && do { - my $rcfile = extract_option_value($_, @ARGV); - if (not $rcfile) - { - print "You must specify a filename to use as the config file!\n"; - exit 8; - } - - @rcfiles = ( $rcfile ); - - last SWITCH; - }; - - /^--prefix=?/ && do { - my $prefix = extract_option_value($_, @ARGV); - if (not $prefix) - { - print "No prefix selected with the --prefix option.\n"; - exit 8; - } - - set_option('global', '#kdedir', $prefix); - set_option('global', '#reconfigure', 1); - - last SWITCH; - }; - - /^--no-rebuild-on-fail$/ && do { - set_option('global', '#no-rebuild-on-fail', 1); - last SWITCH; - }; - - /^--nice=?/ && do { - my $niceness = extract_option_value($_, @ARGV); - - if($niceness) - { - set_option('global', '#niceness', $niceness); - } - else - { - print "You need to specify a value for the --nice option\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; - }; - - /^(--dry-run)|(--pretend)|(-p)$/ && do { - set_option('global', '#pretend', 1); - last SWITCH; - }; - - /^--refresh-build$/ && do { - set_option('global', '#refresh-build', 1); - last SWITCH; - }; - - /^(--revision|-r)=?/ && do { - my $revision = extract_option_value($_, @ARGV); - if (not $revision) - { - print "No revision selected with the --revision option.\n"; - exit 8; - } - - set_option('global', '#revision', $revision); - - last SWITCH; - }; - - /^--resume-from=?/ && do { - $_ = extract_option_value($_, @ARGV); - if (not $_) - { - print "You must pass a module to resume from to the --resume-from option!\n"; - exit 7; - } - - if (defined $package_opts{'global'}{'#resume'}) - { - print "WARNING: Don't pass both --resume and --resume-from\n"; - delete $package_opts{'global'}{'#resume'}; - } - - set_option('global', '#resume-from', $_); - set_option('global', '#no-svn', 1); - last SWITCH; - }; - - /^--resume$/ && do { - if (defined $package_opts{'global'}{'#resume'}) - { - print "WARNING: Don't pass both --resume and --resume-from\n"; - delete $package_opts{'global'}{'#resume-from'}; - } - - set_option('global', '#resume', 1); - set_option('global', '#no-svn', 1); - last SWITCH; - }; - - /^--/ && do { - # First let's see if they're trying to override a global option. - my ($option) = /^--([-\w\d\/]+)/; - my $value = extract_option_value($_, @ARGV); - - if (exists $package_opts{'global'}{$option}) - { - # Global option - set_option('global', "#$option", $value); - } - else - { - # Module specific option. The module options haven't been - # read in, so we'll just have to assume that the module the - # user passes actually does exist. - my ($module, $option) = /^--([\w\/-]+),([-\w\d\/]+)/; - - if (not $module) - { - print "Unknown option $_\n"; - exit 8; - } - - set_option($module, "#$option", $value); - } - - last SWITCH; - }; - - /^-/ && do { print "WARNING: Unknown option $_\n"; last SWITCH; }; - - # Strip trailing slashes. - s/\/*$//; - 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 Subversion 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). -# TODO: This could be improved to not fight over the lock when the scripts are -# handling separate tasks. -sub get_lock -{ - my $lockfile = "$ENV{HOME}/.tdesvn-lock"; - sysopen LOCKFILE, $lockfile, O_WRONLY | O_CREAT | O_EXCL; - my $errorCode = $!; # Save for later testing. - - # 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; - - # Note that we can use color codes at this point since get_lock is called - # after read_options (which sets up the color). - if($errorCode == EEXIST) - { - # Path already exists, read the PID and see if it belongs to a - # running process. - open PIDFILE, "<$lockfile" or do - { - # Lockfile is there but we can't open it?!? Maybe a race - # condition but I have to give up somewhere. - warning " WARNING: Can't open or create lockfile r[$lockfile]"; - return 1; - }; - - my $pid = <PIDFILE>; - close PIDFILE; - - if($pid) - { - # Recent tdesvn-build; we wrote a PID in there. - chomp $pid; - - # See if something's running with this PID. - if (kill(0, $pid) == 1) - { - # Something *is* running, likely tdesvn-build. Don't use error, - # it'll scan for $! - print clr " r[*y[*r[*] tdesvn-build appears to be running. Do you want to:\n"; - print clr " (b[Q])uit, (b[P])roceed anyways?: "; - - my $choice = <STDIN>; - chomp $choice; - - if(lc $choice ne 'p') - { - print clr " y[*] tdesvn-build run canceled.\n"; - exit 1; - } - - # We still can't grab the lockfile, let's just hope things - # work out. - print clr " y[*] tdesvn-build run in progress by user request.\n"; - return 1; - } - - # If we get here, then the program isn't running (or at least not - # as the current user), so allow the flow of execution to fall - # through below and unlink the lockfile. - } # pid - - # No pid found, optimistically assume the user isn't running - # twice. - warning " y[WARNING]: stale tdesvn-build lockfile found, deleting."; - unlink $lockfile; - sysopen LOCKFILE, $lockfile, O_WRONLY | O_CREAT | O_EXCL and do - { - print LOCKFILE "$$\n"; - close LOCKFILE; - }; - return 1; # Hope the sysopen worked. - } - - print LOCKFILE "$$\n"; - close LOCKFILE; - - # Even if we fail it's generally better to allow the script to proceed - # without being a jerk about things, especially as more non-CLI-skilled - # users start using tdesvn-build to build KDE. - return 1; -} - -# Subroutine to free the lock allocated by get_lock() -sub close_lock -{ - my $lockfile = "$ENV{HOME}/.tdesvn-lock"; - - close LOCKFILE; - unlink $lockfile; -} - -sub adjust_update_list -{ - my $list_ref = shift; - my $build_ref = shift; - - # Check to see if the user has requested for 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_needed = grep (get_option ($_, 'use-unsermake'), @{$build_ref}); - - # If the user has told us that they will manage unsermake then we don't - # need to do anything. - $unsermake_needed = 0 if get_option('global', 'use-unsermake') eq 'self'; - - # If the user has set manual-update, don't second-guess them. - $unsermake_needed = 0 if get_option('kdenonbeta', 'manual-update'); - - debug "Do we update unsermake? ", ($unsermake_needed ? 'yes' : 'no'); - - if ($unsermake_needed) - { - if (not list_has(@{$list_ref}, 'kdenonbeta')) - { - whisper "Adding kdenonbeta/unsermake to build."; - - # kdenonbeta isn't being downloaded by the user. - unshift (@{$list_ref}, 'kdenonbeta'); - $package_opts{'kdenonbeta'} = { - 'manual-build' => 'true', - 'checkout-only' => 'unsermake', - '#suppress-auto-admin' => 1, - }; - } - else - { - my $checkouts = get_option('kdenonbeta', 'checkout-only'); - - if ($checkouts !~ /\bunsermake\b/) - { - # kdenonbeta is being checked out, but the user has - # excluded unsermake. - set_option('kdenonbeta', 'checkout-only', "$checkouts unsermake"); - set_option('kdenonbeta', '#suppress-auto-admin', 1); - } - } - } -} - -# Subroutine to get the list of Subversion 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 Subversion 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; - - # We check explicity for sticky options here since they can only be - # set from the command line. - if (get_option('global', '#manual-build')) - { - if (get_option('global', '#resume') || get_option('global', - '#resume-from')) - { - warning "I'm confused, you enabled y[--no-build] and y[--resume]."; - warning "Skipping the build process."; - } - - return (); - } - - if (get_option ('global', '#resume')) - { - if (scalar @ARGV > 0) - { - warning "Ignoring modules specified on command line because y[--resume] was set."; - } - - # Try to determine location of last existing status file. - my $status_fname = get_output_file('existing'); - if (not $status_fname) - { - error "Unable to open status file from last run, can't resume!"; - return (); - } - - my ($line, $oldline); - open STATUS_FILE, "<$status_fname" or do { - error "Can't open $status_fname, so I can't resume!"; - return (); - }; - - while ($line = <STATUS_FILE>) - { - $oldline = $line; - } - - close STATUS_FILE; - - if (not defined $oldline) - { - # Hmm, empty file? - error <<"EOF"; -Unable to read information from resume status file. -It's probably empty, but there's no way to resume! -EOF - return (); - } - - chomp $oldline; - debug "The last success line is $oldline"; - - ($resume_point = $oldline) =~ s/^([^:]+):.*/$1/; - whisper "Resuming at $resume_point"; - } - 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; -} - -# Used to sort module names. 'global' always starts first, modules with / -# sort last. -sub module_sort -{ - # This is always true. - return 0 if $a eq $b; - - # Look for global modules. - return -1 if $a eq 'global'; - return 1 if $b eq 'global'; - - # If both have /, use a normal sort. - return $a cmp $b if $a =~ /\// and $b =~ /\//; - - # If left has slash, it's < $b (and vice versa) - return 1 if $a =~ /\//; - return -1 if $b =~ /\//; - - # Normal sort. - return $a cmp $b; -} - -# 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); - my @keys = sort module_sort keys %package_opts; - my $c; # $c is a color variable to be used with clr() - - # Now dump the options for each module - foreach $item (@keys) - { - debug "\nOptions for module g[$item]:"; - my $ref = $package_opts{$item}; - - foreach $ref_item (sort keys %{$package_opts{$item}}) - { - # Put the first bracket in here, otherwise it breaks on some - # Perl systems. - $c = $ref_item =~ /^#/ ? 'r[' : 'g['; - - if($ref_item !~ /^#?set-env$/) - { - next unless defined $$ref{$ref_item}; - debug " ${c}$ref_item] is \"y[", $$ref{$ref_item}, clr ']"'; - } - else - { - # Dump the environment variables that will be set. - my $setref = $$ref{$ref_item}; - - foreach my $envitem (keys %{$setref}) - { - debug " Set env variable ${c}$envitem] to y[", $$setref{$envitem}; - } - } - } - } -} - -# Subroutine to unlink the given symlink if global-pretend isn't set. -sub safe_unlink -{ - if (pretending) - { - pretend "\tWould have unlinked ", shift, "."; - 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) - { - info "\tExecuting g[", join(" ", @_); - return system (@_) >> 8; - } - - pretend "\tWould have run g[", join(' ', @_); - 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) - { - pretend "\tWould have created g[$pathname]"; - 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; - - whisper "Not building $module"; - - # Weed out matches of the module name - @build_list = grep (!/^$module$/, @build_list); - - push @{$fail_lists{'update'}}, $module; -} - -# Subroutine to split a url into a protocol and host -sub split_url -{ - my $url = shift; - my ($proto, $host) = ($url =~ m|([^:]*)://([^/]*)/|); - - return ($proto, $host); -} - -# This subroutine checks if we are supposed to use ssh agent by examining the -# environment, and if so checks if ssh-agent has a list of identities. If it -# doesn't, we run ssh-add (with no arguments) and inform the user. This can -# be controlled with the disable-agent-check parameter. -sub check_for_ssh_agent -{ - my $agent_running = 0; - my $server = get_option('global', 'svn-server'); - my ($proto, $host) = split_url($server); - - # Don't bother with all this if the user isn't even using SSH. - return 1 if($proto !~ /ssh/) or get_option('global', 'disable-agent-check'); - - # We're using ssh to download, see if ssh-agent is running. - return 1 unless exists $ENV{'SSH_AGENT_PID'}; - - my $pid = $ENV{'SSH_AGENT_PID'}; - - # It's supposed to be running, let's see if there exists the program with - # that pid. - # PORTABILITY NOTE: I'm not sure if this works under *BSD or Solaris. - if (not -e "/proc/$pid") - { - warning "r[ *] SSH Agent is enabled, but y[doesn't seem to be running]."; - warning "Since SSH is used to download from Subversion you may want to see why"; - warning "SSH Agent is not working, or correct the environment variable settings."; - - return 0; - } - - # The agent is running, but does it have any keys? We can't be more specific - # with this check because we don't know what key is required. - my $keys = `ssh-add -l 2>/dev/null`; - if ($keys =~ /no identities/) - { - # Use print so user can't inadvertently keep us quiet about this. - print clr <<EOF; -b[y[*] SSH Agent does not appear to be managing any keys. This will lead to you - being prompted for every module update for your SSH passphrase. So, we're - running g[ssh-add] for you. Please type your passphrase at the prompt when - requested, (or simply Ctrl-C to abort the script). -EOF - my $result = system('ssh-add'); - if ($result) # Run this code for both death-by-signal and nonzero return - { - print "\nUnable to add SSH identity, aborting.\n"; - print "If you don't want tdesvn-build to check in the future,\n"; - print clr "Set the g[disable-agent-check] option to g[true] in your $rcfile.\n\n"; - - return 0; - } - } - - return 1; -} - -# Subroutine to update a list of Subversion 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 $tdesvn = get_tdesvn_dir(); - my $svnroot = get_option ('global', 'svn-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-svn'); - return 0 if scalar @$update_ref == 0; - - return 1 if (not check_for_ssh_agent()); - - note "<<< Updating Subversion Directories >>>"; - info " "; # Add newline for aesthetics unless in quiet mode. - - if (not -e $tdesvn) - { - whisper "KDE Subversion download directory doesn't exist, creating.\n"; - if (not super_mkdir ($tdesvn)) - { - error "Unable to make directory r[$tdesvn]!"; - @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}) - { - my $fullpath = get_fullpath($module, 'source'); - - if (not exists $package_opts{$module}) - { - warning "Unknown module y[$module], configure it in $rcfile."; - - # Continue in case the user just needs default options, hopefully - # it isn't a misspelling. - $package_opts{$module} = { 'set-env' => { } }; - } - - next if get_option($module, 'no-svn'); - - my @options = split(' ', get_option($module, 'checkout-only')); - if (-e "$fullpath/.svn") - { - # Warn user if the current repo URL is different than expected. - check_module_validity($module); - $result = update_module_path($module, @options); - } - else - { - $result = checkout_module_path($module, @options); - } - - if ($result) - { - error "Error updating r[$module], removing from list of packages to build."; - dont_build ($module); - } - - print "\n"; - } - - info "<<< Update Complete >>>\n"; - return $result; -} - -# Subroutine to run the qt-copy apply_patches script. -# Returns 0 on success, non-zero on failure. -sub safe_apply_patches -{ - my %pathinfo = get_module_path_dir('qt-copy', 'build'); - my $builddir = "$pathinfo{fullpath}"; - - if (pretending) - { - pretend "\tWould have run g[./apply_patches]"; - return 0; - } - - info "\tg[Applying recommended Qt patches]."; - chdir ("$builddir"); - 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 $module = shift; - my $fullpath = get_fullpath($module, 'source'); - my $script = "$fullpath/configure"; - - 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'); - my $prefix = get_option ($module, 'prefix'); - - $prefix = $kdedir unless $prefix; - - push @commands, "CXXFLAGS=$cxxflags" if $cxxflags; - push @commands, "--prefix=$prefix"; - - # We're special casing these modules because we're using the lndir - # hack for them. - if (module_needs_builddir_help($module)) - { - $script = get_fullpath($module, 'build') . "/configure"; - } - } - else - { - my $qtdir = get_fullpath('qt-copy', 'build'); - - if(not pretending) - { - # 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"; - - note "\tb[r[GPL license selected for Qt]. See $fullpath/LICENSE.GPL"; - } - - info "\tRunning g[configure]..."; - unshift @commands, $script; - - return log_command($module, "configure", \@commands); -} - -# Subroutine to try and see if we've already tried to update kde-common -sub has_updated_kdecommon -{ - # Test fast case first. - return 1 if get_option('global', '#has-checked-for-admin'); - - # Double check that it wasn't in the update list. - if (grep(/^(KDE\/)?kde-common$/, @update_list)) - { - set_option('global', '#has-checked-for-admin', 1); - return 1; - } - - return 0; -} - -# Subroutine to automatically create an admir dir for a module if it doesn't -# have one. The first parameter is the module name. It is assumed that we -# are already in the source directory, the current directory will not be -# changed. -# -# Returns boolean true on success, boolean false on failure. -# -# NOTE: This subroutine might try to call an svn update, as long as #no-svn -# isn't set. -sub create_admin_dir -{ - my $module = shift; - my $fullpath = get_fullpath($module, 'source'); - - # Don't bother if it's qt-copy, or if we've already got an admin - # directory. - return 1 if $module eq 'qt-copy'; - return 1 if -e "$fullpath/admin"; - - # Find kde-common - my $admindir = get_fullpath('kde-common', 'source') . '/admin'; - if (not -e $admindir) - { - $admindir = get_fullpath('KDE/kde-common', 'source') . '/admin'; - } - - if (not -e $admindir) - { - # Can't find kde-common, it's apparently not installed. - if (not has_updated_kdecommon()) - { - # We haven't tried downloading it, now would be a good time. - note "Can't find y[kde-common], going to try downloading it."; - - if (get_option('global', 'no-svn')) - { - # Not allowed to update. - error "r[!!] Updating has been blocked, can't get y[kde-common]."; - return 0; - } - - # Checkout the directory. - $admindir = get_fullpath('kde-common', 'source') . '/admin'; - if (pretending) - { - pretend "Would have checked out g[kde-common]\n"; - } - elsif (checkout_module_path('kde-common', 'admin') != 0) - { - return 0; - } - } - } - - chdir ($fullpath); - - whisper "\tCreating symbolic link to g[/admin directory]."; - - return symlink $admindir, "$fullpath/admin"; -} - -# Subroutine to recursively symlink a directory into another location, in a -# similar fashion to how the XFree/X.org lndir() program does it. This is -# reimplemented here since some systems lndir doesn't seem to work right. -# -# As a special exception to the GNU GPL, you may use and redistribute this -# function however you would like (i.e. consider it public domain). -# -# The first parameter is the directory to symlink from. -# The second parameter is the destination directory name. -# -# e.g. if you have $from/foo and $from/bar, lndir would create $to/foo and -# $to/bar. -# -# All intervening directories will be created as needed. In addition, you -# may safely run this function again if you only want to catch additional files -# in the source directory. -# -# Note that this function will unconditionally output the files/directories -# created, as it is meant to be a close match to lndir. -# -# RETURN VALUE: Boolean true (non-zero) if successful, Boolean false (0, "") -# if unsuccessful. -sub safe_lndir -{ - my ($from, $to) = @_; - - # Create destination directory. - if (not -e $to) - { - print "$to\n"; - mkdir ($to) unless pretending; - } - - # Create closure callback subroutine. - my $wanted = sub { - my $dir = $File::Find::dir; - my $file = $File::Find::fullname; - $dir =~ s/$from/$to/; - - # Ignore the .svn directory and files. - return if $dir =~ m,/\.svn,; - - # Create the directory. - if (not -e $dir) - { - print "$dir\n"; - - if (not pretending) - { - mkdir ($dir) or die "Couldn't create directory $dir: $!"; - } - } - - # Symlink the file. Check if it's a regular file because File::Find - # has no qualms about telling you you have a file called "foo/bar" - # before pointing out that it was really a directory. - if (-f $file and not -e "$dir/$_") - { - print "$dir/$_\n"; - - if (not pretending) - { - symlink $File::Find::fullname, "$dir/$_" or - die "Couldn't create file $dir/$_: $!"; - } - } - }; - - # Recursively descend from source dir using File::Find - eval { - find ({ 'wanted' => $wanted, - 'follow_fast' => 1, - 'follow_skip' => 2}, - $from); - }; - - if ($@) - { - $! = 0; # sub error will use $! to display error message. - error "Unable to symlink $from to $to: $@"; - return 0; - } - - return 1; -} - -# Subroutine to link a source directory into an alternate directory in order -# to fake srcdir != builddir for modules that don't natively support it. -# The first parameter is the module to prepare. -# -# The return value is true (non-zero) if it succeeded, and 0 (false) if it -# failed. -# -# On return from the subroutine the current directory will be in the build -# directory, since that's the only directory you should touch from then on. -# -# You may safely call this subroutine for modules that don't need it, they -# will automatically be ignored. -sub prepare_fake_builddir -{ - my $module = shift; - my $builddir = get_fullpath($module, 'build'); - my $srcdir = get_fullpath($module, 'source'); - - # List reference, not a real list. The initial tdesvn-build does *NOT* - # fork another tdesvn-build using exec, see sub log_command() for more - # info. - my $args = [ 'tdesvn-build', 'safe_lndir', $srcdir, $builddir ]; - - # Skip modules that don't need special treatment. - return 1 unless module_needs_builddir_help($module); - - # Backwards compatibility hack. - # tdesvn-build 0.97 and earlier would physically copy the Qt source - # directory to the build directory. tdesvn-build versions after that use - # the lndir program that is used for tdebindings and valgrind for - # portability reasons. This will break for users who have a real copy of - # Qt, so check here if the qt-copy configure script file is a real file - # (not a symlink), and if so, use the old method (since presumably it - # worked earlier). - if ($module eq 'qt-copy' and -e "$builddir/configure" and not -l "$builddir/configure") - { - whisper "Using deprecated qt-copy builddir faking method."; - - # Use old method of copying. - $args = [ 'cp', '-af', $srcdir, $builddir ]; - } - - # Use an internal routine to complete the directory symlinking (or the - # alternate routine in the case of old qt-copy). - if (log_command ($module, 'create-builddir', $args)) - { - warning "\tUnable to setup special build system for r[$module]."; - return 0; - } - - return 1; # Success -} - -# 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 $module = shift; - my $fullpath = get_fullpath($module, 'source'); - my $builddir = get_fullpath($module, 'build'); - my $instapps = get_option($module, 'inst-apps'); - - if (pretending) - { - pretend "\tWould have created g[$module]\'s build system."; - return 0; - } - - chdir ($fullpath); # Run make -f Makefile.cvs in srcdir. - - # These modules will run make -f Makefile.cvs in (fake) builddir to keep - # srcdir clean. Except for qt-copy when not using qt-builddir-hack. - if(module_needs_builddir_help($module)) - { - chdir ($builddir); - } - - return 0 if $module eq 'qt-copy'; # since 3.3.6 - - if ($instapps) - { - open (INSTAPPS, ">inst-apps") or do { - error "\tUnable to create inst-apps file for r[$module]!"; - return 1; - }; - - print INSTAPPS "$instapps\n"; - close INSTAPPS; - } - else - { - unlink ("$fullpath/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)) - { - error "\tUnable to create build system for r[$module]"; - 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 $module = shift; - my $builddir = get_fullpath($module, 'build'); - 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) - { - debug "Build directory not setup for $module." if not -e "$builddir"; - debug ".refresh-me exists for $module." if -e "$builddir/.refresh-me"; - debug "refresh-build option set for $module." if get_option($module, 'refresh-build'); - debug "Can't find configure key file for $module." if not -e "$builddir/$conf_file_key"; - } - - return 1 if ((not -e "$builddir") || - (-e "$builddir/.refresh-me") || - get_option($module, "refresh-build") || - (not -e "$builddir/$conf_file_key")); - - return 0; -} - -# Run the svn command. This is a special subroutine so that we can munge the -# generated output to see what files have been added, and adjust the build -# according. -# First parameter is the module we're building. -# Second parameter is the filename to use for the log file. -# Third parameter is a reference to a list, which is the command ('svn') and all -# of its arguments. -sub run_svn -{ - my ($module, $logfilename, $arg_ref) = @_; - my %hash_count; - my $result; - my $force_refresh = 0; - my $conflict = 0; - my $logdir = get_log_dir($module); - - my $revision = get_option('global', 'revision'); - if ($revision ne '0') - { - my @tmp = @{$arg_ref}; - - # Insert after first two entries, deleting 0 entries from the - # list. - splice @tmp, 2, 0, '-r', $revision; - $arg_ref = \@tmp; - } - - # Do svn 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 Subversion process - # did. - open SVN_LOG, "<$logfilename"; - while (<SVN_LOG>) - { - # The check for capitalized letters in the second column is because - # svn can use the first six columns for updates (the characters will - # all be uppercase), which makes it hard to tell apart from normal - # sentences (like "At Revision foo" - - # Count updates and patches together. - $hash_count{'updated'}++ if /^U[ A-Z]/; - $hash_count{'updated'}++ if /^P[ A-Z]/; - $hash_count{'deleted'}++ if /^D[ A-Z]/; - $hash_count{'added'}++ if /^A[ A-Z]/; - $hash_count{'removed'}++ if /^R[ A-Z]/; - $hash_count{'merged'}++ if /^G[ A-Z]/; - $hash_count{'modified'}++ if /^M[ A-Z]/; - $hash_count{'conflicted'}++ if /^C[ A-Z]/; - - # Check if we need to force a refresh. - $force_refresh = 1 if /^A[ A-Z]/ and /Makefile\.am/; - $force_refresh = 1 if /^[PAMGU][ A-Z]/ and /configure\.in\.in/; - - $conflict = 1 if /^C[ A-Z]/; - } - - close SVN_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', - 'deleted' => 'files were deleted', - '1deleted' => 'file was deleted', - 'merged' => 'files had changes merged', - '1merged' => 'file had changes merged', - ); - - 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}; - info "\t$value $ending."; - } - - if ($conflict) - { - warning "Source code conflict exists in r[$module], this module will not"; - warning "build until it is resolved."; - dont_build($module); - - return $result; - } - - if ($force_refresh and -e get_fullpath($module, 'build')) - { - info "File(s) related to the build system were updated, forcing a refresh."; - set_option($module, 'refresh-build', 1); - set_option($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_fullpath($module, 'source'); - my $builddir = get_fullpath($module, 'build'); - - if (pretending) - { - pretend "\tWould have cleaned build system for g[$module]"; - return 1; - } - - if (not -e $moduledir) - { - warning "\tUnable to clean build system for r[$module], it's not been checked out!"; - return 0; - } - - # Clean qt-copy separately - if ($module eq 'qt-copy' and not get_option('qt-copy', 'use-qt-builddir-hack')) - { - chdir ("$builddir"); - - if (log_command ('qt-copy', 'clean', ['make', 'clean'])) - { - warning "\tr[WARNING]: Error cleaning r[qt-copy]."; - } - - unlink ("$builddir/.qmake.cache"); - - return 1; - } - - if (-e "$builddir") - { - if(safe_system ('rm', '-rf', "$builddir")) - { - # Remove build directory for normal module. - error "\tUnable to clean r[$builddir]."; - return 0; # False for this function. - } - - # Let users know we're done so they don't wonder why rm -rf is taking so - # long and oh yeah, why'd my HD so active?... - info "\tOld build system cleaned, starting new build system."; - } - - # Now create the directory - if (not super_mkdir ("$builddir")) - { - error "\tUnable to create directory r[$builddir]."; - 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 $fullpath = get_fullpath($module, 'source'); - my $builddir = get_fullpath($module, 'build'); - my $do_configure = get_option ($module, 'reconfigure'); - my $do_makeconf = get_option ($module, 'recreate-configure'); - - 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. - info "\tPreparing build system for y[$module]."; - - # Define this option to tell later functions that we tried to rebuild - # this module. - set_option($module, '#was-rebuilt', 1); - - # Check to see if we're actually supposed to go through the cleaning - # process. - if (not get_option($module, '#cancel-clean') and - not clean_build_system($module)) - { - warning "\tUnable to clean r[$module]!"; - return 0; - } - - $do_makeconf = 1; - } - - # Symlink source directory to build directory if module doesn't support - # srcdir != builddir. If it's qt-copy only do so if use-qt-builddir-hack - # is on (true by default). Note that module_needs_builddir_help() already - # takes care of that test. - if (module_needs_builddir_help($module)) - { - whisper "\tFaking builddir for g[$module]"; - if (not prepare_fake_builddir($module)) - { - error "Error creating r[$module] build system!"; - return 0; - } - } - - # Check for admin dir, if it doesn't exist, create a softlink - if (not create_admin_dir($module)) - { - warning "Unable to find /admin directory for y[$module], it probably"; - warning "won't build."; - # But continue anyways, because in this case I'm just not sure that it - # won't work in the future. ;) - } - - my $confpath = module_needs_builddir_help($module) ? $builddir : $fullpath; - - if ($do_makeconf or not -e "$confpath/configure") - { - whisper "\ty[Recreating configure script]."; - - # Update the PATH and other important environment variables. - update_module_environment ($module); - - if (safe_create_build_system ($module)) - { - error "\tUnable to create configure system from checkout."; - return 0; - } - - $do_configure = 1; - - if ($module eq "qt-copy" and 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'); - } - - # File which exists after configure has been run. - my $conf_key_file = "$builddir/Makefile"; - $conf_key_file = "$builddir/src/tools/qconfig.cpp" if $module eq 'qt-copy'; - - if ($do_configure or not -e $conf_key_file) - { - if (not -e "$builddir" and not super_mkdir("$builddir")) - { - error "\tUnable to create build directory for r[$module]!!"; - return 0; - } - - # Now we're in the checkout directory - # So, switch to the build dir. - # builddir is automatically set to the right value for qt-copy - chdir ("$builddir"); - - # configure the module (sh script return value semantics) - if (safe_configure ($module)) - { - error "\tUnable to configure r[$module]!"; - 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 $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 tqchildren'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/:*$//; - } - - # 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")) - { - my $kdenonbeta = get_fullpath('kdenonbeta', 'source'); - $path = "$kdenonbeta/unsermake:$path"; - } - else - { - setenv ("UNSERMAKE", "no"); - } - - setenv ('LD_LIBRARY_PATH', $libdir); - setenv ('PATH', $path); - setenv ('KDEDIR', $kdedir); - setenv ('QTDIR', $qtdir); - - # 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") - { - whisper "\ty[$builddir] doesn't exist, creating."; - if (not super_mkdir ("$builddir")) - { - error "\tUnable to create r[$builddir]!"; - 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); - - return $str; -} - -# Subroutine to determine if a given module can run make apidox. Returns -# boolean true if make apidox can be run. -sub make_apidox_supported -{ - my $module = shift; - - return $module =~ /^(KDE\/)?(kde(base|games|graphics|libs|pim|velop)|koffice)$/; -} - -# 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 $apidox = shift; - my $builddir = get_fullpath($module, 'build'); - my $trynumber = 1; - - # Do some tests to make sure we're ready to build. - if (not exists $package_opts{$module}) - { - warning "Unknown module y[$module], configure it in $rcfile."; - $package_opts{$module} = { 'set-env' => { } }; - } - - update_module_environment($module); - - if($module eq 'qt-copy' and $builddir ne get_option('global', 'qtdir')) - { - my $qtpath = $builddir; - $qtpath =~ s/$ENV{HOME}/~/; - warning <<EOF; - -b[y[!!] You're building qt-copy, but QTDIR isn't set to use qt-copy! -b[y[!!] Please set your qtdir variable in the global section of your -b[y[!!] $rcfile to g[$qtpath] - -EOF - } - - my $start_time = time; - while (not defined $package_opts{$module}->{'#was-rebuilt'}) - { - note "Building g[$module] ($cur_module_num/$total_module_num)"; - 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. - note "\n\tUnable to build y[$module]!"; - info "\tTook g[$elapsed]."; - return 0; - } - - if ($trynumber == 2) - { - # Just try again - info "\n\ty[Couldn't build, going to try again just in case]."; - info "\tTook g[$elapsed]."; - next; - } - - # Don't remove the old modules, but re-run make -f - # Makefile.cvs and configure. - info "\n\tStill couldn't build, recreating build system (builddir is safe)."; - info "\tTook g[$elapsed] of time."; - - set_option($module, '#cancel-clean', 1); - set_option($module, 'refresh-build', 1); - - # Loop again - } - else - { - # Build succeeded, build docs if necessary - my $apidox_result = 0; - my $build_apidox = make_apidox_supported($module) && get_option($module, 'apidox'); - if ($build_apidox) - { - $apidox_result = safe_make ($module, $trynumber, 1); - error "\tCouldn't build API Documentation" if $apidox_result; - } - - my $elapsed = prettify_seconds (time - $start_time); - my $do_install = get_option($module, 'install-after-build'); - - info "\tBuild done after g[$elapsed]."; - if ($do_install) - { - handle_install($module, 0); - handle_install($module, 1) if $build_apidox and $apidox_result == 0; - } - else - { - info "\tSkipping install for y[$module]"; - } - - 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 $tdesvn 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 @build_done; - my $build_ref = shift; - my $tdesvn = get_tdesvn_dir(); - my $svnroot = get_option ('global', 'svn-server'); - my $module; - my @modules = grep (!/^(KDE\/)?kde-common$/, @{$build_ref}); - my $result; - my $outfile = get_output_file (); - - # No reason to print building messages if we're not building. - return 0 if scalar @modules == 0; - - note "<<< Build Process >>>"; - - # Save the environment to keep module's env changes from affecting other - # modules. - my %env_backup = %ENV; - - if (pretending) - { - pretend "\tWould have opened status file g[$outfile]."; - $outfile = undef; # Don't actually try it though. - } - - if ($outfile) - { - open STATUS_FILE, ">$outfile" or do { - error <<EOF; - Unable to open output status file r[b[$outfile] - You won't be able to use the g[--resume] switch next run.\n"; -EOF - $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; - - info "\tOverall time for g[$module] was g[$elapsed]."; - push @build_done, $module; - } - else - { - my $elapsed = prettify_seconds(time - $start_time); - print STATUS_FILE "$module: Failed after $elapsed.\n" if $outfile; - - info "\tOverall time for r[$module] was g[$elapsed]."; - push @{$fail_lists{'build'}}, $module; - - if (get_option($module, 'stop-on-failure')) - { - note "\n$module didn't build, stopping here."; - return 1; # Error - } - } - - print "\n"; - %ENV = %env_backup; - $i++; - } - - # If we have packages that failed to update we should probably mention them - # in the build-status file as well. - if ($outfile) - { - for my $failure (@{$fail_lists{'update'}}) - { - print STATUS_FILE "$failure: Failed on update.\n"; - } - - close STATUS_FILE; - } - - info "<<< Build Done >>>\n"; - info "\n<<< g[PACKAGES SUCCESSFULLY BUILT] >>>" if scalar @build_done > 0; - - if (not pretending) - { - # Print out results, and output to a file - open BUILT_LIST, ">$tdesvn/successfully-built"; - foreach $module (@build_done) - { - info "$module"; - print BUILT_LIST "$module\n"; - } - close BUILT_LIST; - } - else - { - # Just print out the results - info 'g[', join ("]\ng[", @build_done), ']'; - } - - info " "; # Add newline for aesthetics if not in quiet mode. - return scalar @{$fail_lists{'build'}}; -} - -# 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() unless pretending; - - note "Your logs are saved in y[$logdir]"; - exit $exitcode; -} - -# Subroutine to determine the current repository URL for the current working -# directory. -sub get_repo_url -{ - my $output = `svn info | grep URL`; - $output =~ s/URL: (.*)$/$1/; - chomp $output; - - return $output; -} - -# Subroutine to determine whether or not the given module has the correct -# URL. If not, a warning is printed out. -# First parameter: module to check. -# Return: Nothing. -sub check_module_validity -{ - # This test reads the HD so don't bother during pretend. - return if pretending; - - my $module = shift; - my $source_dir = get_fullpath($module, 'source'); - my $module_expected_url = svn_module_url($module); - - chdir($source_dir); # Required for get_repo_url - my $module_actual_url = get_repo_url(); - - if($module_actual_url ne $module_expected_url) - { - warning <<EOF; - y[!!] - y[!!] g[$module] seems to be checked out from somewhere other than expected. - y[!!] - -tdesvn-build expects: y[$module_expected_url] -The module is actually from: y[$module_actual_url] - -If the module location is incorrect, you can fix it by either deleting the -g[b[source] directory, or by changing to the source directory and running - svn switch $module_expected_url - -If the module is fine, please update your configuration file. -EOF - } -} - -# Subroutine to handle the installation process. Simply calls -# 'make install' in the directory. -sub handle_install -{ - my $apidox = pop; # Take parameter off end of list (@_). - my @no_install_modules = qw/qt-copy kde-common/; - my $result = 0; - - for my $module (@_) - { - if (list_has(@no_install_modules, $module)) - { - info "\tg[$module] doesn't need to be installed."; - next; - } - - my $builddir = get_fullpath($module, 'build'); - - if (not exists $package_opts{$module}) - { - warning "\tUnknown module y[$module], configure it in $rcfile."; - $package_opts{$module} = { 'set-env' => { } }; - next; - } - - if (not -e "$builddir/Makefile") - { - warning "\tThe build system doesn't exist for r[$module]."; - warning "\tTherefore, we can't install it. y[:-(]."; - next; - } - - # Just in case, I guess. - update_module_environment ($module); - - # The /admin directory is needed for install as well, make sure it's - # there. - if (not create_admin_dir($module)) - { - warning "Unable to find /admin directory for y[$module], it probably"; - warning "won't install."; - # But continue anyways, because in this case I'm just not sure that it - # won't work in the future. ;) - } - - # 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", $apidox)) - { - error "\tUnable to install r[$module]!"; - $result = 1; - push @{$fail_lists{'install'}}, $module; - - if (get_option($module, 'stop-on-failure')) - { - note "y[Stopping here]."; - return 1; # Error - } - } - - if (pretending) - { - pretend "\tWould have installed g[$module]"; - next; - } - - next if $result != 0; # Don't delete anything if the build failed. - - my $remove_setting = get_option($module, 'remove-after-install'); - - # Possibly remove the srcdir and builddir after install for users with - # a little bit of HD space. - if($remove_setting eq 'all') - { - # Remove srcdir - my $srcdir = get_fullpath($module, 'source'); - note "\tRemoving b[r[$module source]."; - system ('rm', '-rf', $srcdir); - } - - if($remove_setting eq 'builddir' or $remove_setting eq 'all') - { - # Remove builddir - note "\tRemoving b[r[$module build directory]."; - system ('rm', '-rf', $builddir); - } - } - - 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 -{ - debug "Munging update and build list"; - my $cleared = 0; - - for my $list_ref ( ( \@update_list, \@build_list) ) { - my @temp; - - while ($_ = shift @$list_ref) { - # Split at directory separators. - my ($modulename, @dirs) = split(/\//); - - # For these modules, the first part of the directory separator - # actually belongs with the module name. - if (has_base_module($modulename)) - { - $modulename .= "/" . shift @dirs; - } - - if (scalar @dirs > 0) - { - # Only build the specified subdirs - if (not $cleared) - { - debug "Clearing checkout-only option."; - - $cleared = 1; - set_option($modulename, 'checkout-only', ''); - } - - # The user has included a directory separator in the module name, so - # let's fake the svn partial checkout - $_ = $modulename; - - # Don't automatically add the /admin dir for this module now. - set_option($_, '#suppress-auto-admin', 1); - - my $checkout_str = join ("/", @dirs); - - debug "Adding $checkout_str to checkout-only for $_"; - - if (get_option($_, 'checkout-only') !~ /$checkout_str/) - { - $package_opts{$_}{'checkout-only'} .= " $checkout_str"; - } - else - { - debug print "\tOption was already present."; - } - } - else - { - debug "Skipping $_ in munge process."; - } - - # Don't add the modulename to the list twice. - push @temp, $_ if not list_has(@temp, $_); - } - - @$list_ref = @temp; - } -} - -# Subroutine to try an intelligently determine what caused the module to fail -# to build/update/whatever. The first parameter is the name of the module, -# and the return value is the best guess at the error. If no error is detected -# the last 30 lines of the file are returned instead. -sub whats_the_module_error -{ - my $module = shift; - my $file = get_option($module, '#error-log-file'); - - open ERRORFILE, "<$file" or return "Can't open logfile $file.\n"; - - my @lastlines; # Used to buffer last lines read. - my @errors; # Tracks errors and the file they were found in. - my $lastfile = ''; # Tracks last filename read in error log. - my $errorCount = 0; - my $output; - - # TODO: This code is tested for gcc and GNU ld, as, etc, I'm not sure how - # effective it is at parsing the error output of other build toolchains. - while (<ERRORFILE>) - { - # Keep last 30 lines. - push @lastlines, $_; - shift @lastlines if scalar @lastlines > 30; - - my ($file, $line, $msg) = /^([^:]*):(\d+):\s*(.*)$/; - - next unless ($file and $line and $msg); - next if $msg =~ /warn/i; - next if $msg =~ /^in file included from/i; - next if $msg =~ /^\s*$/ or $file =~ /^\s*$/; - $msg =~ s/^error: ?//i; - - if ($file eq $lastfile) - { - $errorCount++; - push @errors, $msg if $errorCount < 5; - } - else - { - # Check is because we print info on the last file read, so there - # should be a last file. ;) - if ($lastfile) - { - my $error = $errorCount == 1 ? "error" : "errors"; - $output .= "$errorCount $error in $lastfile\n"; - $output .= "Error: $_\n" foreach (@errors); - $output .= "\t<clipped>\n" if $errorCount > 5; - $output .= "\n"; - } - - $errorCount = 1; - @errors = ($msg); - } - - $lastfile = $file; - } - - close ERRORFILE; - - if (not $lastfile) - { - # Print out last lines read, hopefully a more descriptive error - # message is in there. - $output .= "Can't find errors, last " . scalar @lastlines . " line(s) of the output are:\n"; - $output .= $_ foreach (@lastlines); - return $output; - } - - # Don't forget to display info on last file read since it won't be done in - # the loop. - my $error = $errorCount == 1 ? "error" : "errors"; - $output .= "$errorCount $error in $lastfile\n"; - $output .= "Error: $_\n" foreach (@errors); - $output .= "\t<clipped>\n" if $errorCount > 5; - - return $output; -} - -# Subroutine to get the e-mail address to send e-mail from. -# It is pulled from the global email-address option by default. -# The first parameter is a default e-mail address to use (may be left off, in -# which case this function will create a default of its own if necessary.) -sub get_email_address -{ - my $email = get_option('global', 'email-address'); - my $default = shift; - - # Use user's value if set. - return $email if $email; - - # Let's use the provided default if set. - return $default if $default; - - # Let's make a default of our own. It's likely to suck, so oh well. - use Sys::Hostname; - my $username = getpwuid($>); - my $hostname = hostname; # From Sys::Hostname - - debug "User has no email address, using $username\@$hostname"; - - return "$username\@$hostname"; -} - -# Subroutine to look through the various failed lists, and send an email to the -# given email address with a description of the failures. If the user has -# selected no email address the subroutine does nothing. -sub email_error_report -{ - my $email_addy = get_option('global', 'email-on-compile-error'); - my $from_addy = get_email_address($email_addy); - - return unless $email_addy; - - # Initial e-mail header. - my $email_body = <<EOF; -The following errors were detected in the tdesvn-build run just completed. - -EOF - - # Loop through modules trying to find out what caused the errors. - my $had_error = 0; - for my $type (@fail_display_order) - { - for my $module (@{$fail_lists{$type}}) - { - $email_body .= "$module failed to $type:\n"; - $email_body .= "-------------------------------\n\n"; - $email_body .= whats_the_module_error($module); - $email_body .= "-------------------------------\n\n"; - - $had_error = 1; - } - } - - return unless $had_error; - - # Detect Mail::Mailer. - my $mailer; - eval { - require Mail::Mailer; - - $mailer = new Mail::Mailer; - } or do { - error " y[*] Can't open y[b[Mail::Mailer] module, so e-mailing is disabled."; - debug "Error was $@"; - return; - }; - - # Sendeth the email. - $mailer->open({ - 'From' => $from_addy, - 'To' => $email_addy, - 'Subject' => 'KDE Subversion build compile error', - }); - - print $mailer $email_body; - $mailer->close; -} - -# This subroutine sets up or removes the default branch option for a few -# modules in order to build KDE 3.5 by default. branch options in the -# configuration file will still override these settings. -sub setup_trinity5_hack -{ - my @branched_modules = qw/kde-common tdeaccessibility tdeaddons tdeadmin - tdeartwork tdebase tdebindings tdeedu tdegames tdegraphics tdelibs - tdemultimedia tdenetwork tdepim tdesdk tdetoys tdeutils tdevelop - tdewebdev/; - - # arts uses a different versioning scheme. - set_option('arts', 'branch', '1.5'); - - # koffice 1.5 is the last KDE 3 compatible release. - set_option('koffice', 'branch', '1.5'); - - # qt-copy is in branches/qt/3.3. Due to the default option handling the - # handling is done in setup_default_modules(). - # set_option('qt-copy', 'module-base-path', 'branches/qt/3.3'); - - for my $module (@branched_modules) - { - # Default to downloading from KDE 3.5 instead of KDE 4. - set_option($module, 'branch', '3.5'); - } -} - -# 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. - setup_trinity5_hack(); # Add 'branch' options as appropriate. - 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 submit a bug against tdesvn-build on http://bugs.kde.org/\n"; - - # Don't finish, because we haven't attained the lock yet. - exit 99; -} - -if (not pretending and 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; - info "Script started processing at g[$time]"; - - @update_list = get_update_list(); - @build_list = get_build_list(); - - debug "Update list is ", join (', ', @update_list); - debug "Build list is ", join (', ', @build_list); - - # Do some necessary adjusting. Right now this is used for supporting - # the command-line option shortcut to where you can enter e.g. - # tdelibs/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; - } - else - { - # Installation mode (no apidox) - $result = handle_install (get_install_list(), 0); - } - - output_failed_module_lists(); - email_error_report(); - - $time = localtime; - my $color = ''; - $color = 'r[' if $result; - - info "${color}Script finished processing at g[$time]"; -}; - -if ($@) -{ - # We encountered an error. - print "Encountered an error in the execution of the script.\n"; - print "The error reported was $@\n"; - print "Please submit a bug against tdesvn-build on http://bugs.kde.org/\n"; - - $result = 99; -} - -finish($result); - -# vim: set et sw=4 ts=4: |