You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
4287 lines
130 KiB
4287 lines
130 KiB
#!/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 tdedir 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" => "",
|
|
"tdedir" => "$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 tdedir
|
|
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', 'tdedir') . "/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
|
|
tdedir 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', '#tdedir', $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 $tdedir = get_option ('global', 'tdedir');
|
|
my $prefix = get_option ($module, 'prefix');
|
|
|
|
$prefix = $tdedir 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 $tdedir = get_option ($module, 'tdedir');
|
|
my $qtdir = get_option ($module, 'qtdir');
|
|
my $path = join(':', "$qtdir/bin", "$tdedir/bin", get_option ($module, 'binpath'));
|
|
my $libdir = join(':', "$qtdir/lib", "$tdedir/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 ('TDEDIR', $tdedir);
|
|
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:
|