~ubuntu-branches/ubuntu/oneiric/kdesdk/oneiric-updates

#!/usr/bin/perl -w

# Script to handle building KDE from source code.  All of the configuration is
# stored in the file ~/.kdesrc-buildrc.
#
# Please also see the documentation that should be included with this program,
# from the kdesdk/doc/scripts/kdesrc-build directory.
#
# Copyright © 2003 - 2010 Michael Pyne. <mpyne@kde.org>
# Home page: http://kdesrc-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).

# Pod documentation: Removed in favor of --help and the index.docbook in the
# kdesdk/doc/scripts/kdesrc-build directory.

use strict;
use warnings;
use Fcntl;    # For sysopen constants
use POSIX qw(strftime :sys_wait_h);
use File::Find; # For our lndir reimplementation.
use File::Basename;
use File::Spec;
use File::Glob ':glob';
use Sys::Hostname;
use IO::Handle;
use IO::File;
use IPC::Open3;
use Errno qw(:POSIX);
use Data::Dumper;
use 5.008_000; # Require Perl 5.8.0

# Debugging level constants.
use constant {
    DEBUG   => 0,
    WHISPER => 1,
    INFO    => 2,
    NOTE    => 3,
    WARNING => 4,
    ERROR   => 5,
};

use constant {
    # We use a named remote to make some git commands work that don't accept the
    # full path.
    GIT_REMOTE_ALIAS => '__kdesvn-build-remote', # Historical name
};

{
    # Separate package for namespacing.
    package IPC;
# IPC message types
    use constant {
        MODULE_SUCCESS  => 1, # Used for a successful src checkout
        MODULE_FAILURE  => 2, # Used for a failed src checkout
        MODULE_SKIPPED  => 3, # Used for a skipped src checkout (i.e. build anyways)
        MODULE_UPTODATE => 4, # Used to skip building a module when had no code updates

        # One of these messages should be the first message placed on the queue.
        ALL_SKIPPED     => 5, # Used to indicate a skipped update process (i.e. build anyways)
        ALL_FAILURE     => 6, # Used to indicate a major update failure (don't build)
        ALL_UPDATING    => 7, # Informational message, feel free to start the build.

        # Used to indicate specifically that a source conflict has occurred.
        MODULE_CONFLICT => 8,
    };
}

my $versionNum = '1.12.1-pre';

# 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.
our %package_opts = (
  'global' => {
    "async"               => 1,
    "binpath"             => '',
    "build-when-unchanged"=> 1, # Safe default
    "branch"              => "",
    "build-dir"           => "build",
    "build-system-only"   => "",
    "checkout-only"       => "",
    "cmake-options"       => "",
    "configure-flags"     => "",
    "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
    "disable-snapshot"    => 0,   # If true, don't check for module snapshots.
    "do-not-compile"      => "",
    "email-address"       => "",
    "email-on-compile-error" => "",
    "git-repository-base" => {}, # Base path template for use multiple times.
    "use-modules"         => "",
    "install-after-build" => 1,  # Default to true
    "kdedir"              => "$ENV{HOME}/kde",
    "kde-languages"       => "",
    "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"              => "",
    "override-url"        => "",
    "prefix"              => "", # Override installation prefix.
    "pretend"             => "",
    "purge-old-logs"      => 0,
    "qtdir"               => "$ENV{HOME}/kdesrc/build/qt-copy",
    "reconfigure"         => "",
    "refresh-build"       => "",
    "remove-after-install"=> "none", # { none, builddir, all }
    "repository"          => '',     # module's git repo
    "revision"            => 0,
    "run-tests"           => 0,  # 1 = make test, upload = make Experimental
    "set-env"             => { }, # Hash of environment vars to set
    "source-dir"          => "$ENV{HOME}/kdesrc",
    "stop-on-failure"     => "",
    "svn-server"          => "svn://anonsvn.kde.org/home/kde",
    "tag"                 => "",
    "use-clean-install"   => 0,
    "use-idle-io-priority"=> 0,
  }
);

# This hash is used to store environment variables to be used on the next
# execution of log_command().  This is done so that we don't have to fork new
# processes just to change values in the environment.
#
# Previously we simply saved %ENV in a temp hash, but that broke on some systems.
# Then we used 'local %ENV' to push/pop the environment from a stack but it only
# really worked on the developer's system. :(
#
# Now we save environment variables to set right after forking...
#
# Don't use this except via setenv(), resetenv(), and log_command().
our %ENV_VARS;

# Base class for IPC interaction. Should have most of the functionality, with
# the actual bits of reading and writing left to subclasses.
{
    package BaseIPC;

    sub new
    {
        my $class = shift;

        # Must bless a hash ref since subclasses expect it.
        my $ref = {};
        $ref->{'residue'} = ''; # Define this for later.

        return bless $ref, $class;
    }

    sub notifyUpdateSuccess
    {
        my $self = shift;
        my ($module, $msg) = @_;

        $self->sendIPCMessage(main::IPC::MODULE_SUCCESS, "$module,$msg");
    }

    # Sends an IPC message along with some IPC type information.
    #
    # First parameter is the IPC type to send.
    # Second parameter is the actual message.
    # All remaining parameters are sent to the object's sendMessage()
    #  procedure.
    sub sendIPCMessage
    {
        # Use shift for these to empty @_ of the parameters.
        my $self = shift;
        my $ipcType = shift;
        my $msg = shift;

        my $encodedMsg = pack("l! a*", $ipcType, $msg);
        return $self->sendMessage("$encodedMsg\n", @_);
    }

    # Static class function to unpack a message.
    #
    # First parameter is the message.
    # Second parameter is a reference to a scalar to store the result in.
    #
    # Returns the IPC message type.
    sub unpackMsg
    {
        my ($msg, $outBuffer) = @_;
        my $returnType;

        ($returnType, $$outBuffer) = unpack("l! a*", $msg);

        return $returnType;
    }

    # Receives an IPC message and decodes it into the message and its
    # associated type information.
    #
    # First parameter is a *reference* to a scalar to hold the message contents.
    # All remaining parameters are passed to the underlying receiveMessage()
    #  procedure.
    #
    # Returns the IPC type, or undef on failure.
    sub receiveIPCMessage
    {
        my $self = shift;
        my $outBuffer = shift;

        # Check if we still have data left over from last read, and if it
        # contains a full message.
        if ($self->{'residue'} =~ /\n/)
        {
            my ($first, $remainder) = split(/\n/, $self->{'residue'}, 2);
            $self->{'residue'} = defined $remainder ? $remainder : '';

            return unpackMsg($first, $outBuffer);
        }

        # Read in messages enough to get to the message separator (\n)
        my $msg = '';
        while($msg !~ /\n/) {
            my $msgFragment = $self->receiveMessage(@_);
            $msg .= $msgFragment if defined $msgFragment;

            last unless defined $msgFragment;
        }

        return undef if not defined $msg or $msg eq '';

        # We may have residue still if we had a partial husk of a message, so
        # append to the residue before breaking up the message.  We assume a
        # newline separates the messages.
        $msg = $self->{'residue'} . $msg;
        my ($first, $remainder) = split(/\n/, $msg, 2);

        # Save rest for later.
        $self->{'residue'} = defined $remainder ? $remainder : '';

        return unpackMsg($first, $outBuffer);
    }

    # These must be reimplemented.  They must be able to handle scalars without
    # any extra frills.
    #
    # sendMessage should accept one parameter (the message to send) and return
    # true on success, or false on failure.  $! should hold the error information
    # if false is returned.
    sub sendMessage { die "Unimplemented.\n"; }

    # receiveMessage should return a message received from the other side, or
    # undef for EOF or error.  On error, $! should be set to hold the error
    # information.
    sub receiveMessage { die "Unimplemented.\n" }

    # Should be reimplemented if default does not apply.
    sub supportsConcurrency
    {
        return 0;
    }
}

# IPC class that uses pipes for communication.  Basically requires
# forking two children in order to communicate with.  Assumes that the two
# children are the update process and a monitor process which keeps the update
# going and informs us (the build process) of the status when we're ready to
# hear about it.
{
    package PipeIPC;

    our(@ISA);
    @ISA = qw(BaseIPC);

    sub new
    {
        my $class = shift;
        my $self = $class->SUPER::new;

        # Define file handles.
        $self->{$_} = new IO::Handle foreach qw/fromMon toMon fromSvn toBuild/;

        if (not pipe($self->{'fromSvn'}, $self->{'toMon'})or
            not pipe($self->{'fromMon'}, $self->{'toBuild'}))
        {
            return undef;
        }

        return bless $self, $class;
    }

    # Must override to send to correct filehandle.
    sub notifyUpdateSuccess
    {
        my $self = shift;
        my ($module, $msg) = @_;

        $self->sendIPCMessage(main::IPC::MODULE_SUCCESS, "$module,$msg", 'toMon');
    }

    # Closes the given list of filehandle ids.
    sub closeFilehandles
    {
        my $self = shift;
        my @fhs = @_;

        for my $fh (@fhs) {
            close $self->{$fh};
            $self->{$fh} = 0;
        }
    }

    # Call this to let the object know it will be the update process.
    sub setUpdater
    {
        my $self = shift;
        $self->closeFilehandles(qw/fromSvn fromMon toBuild/);
    }

    sub setBuilder
    {
        my $self = shift;
        $self->closeFilehandles(qw/fromSvn toMon toBuild/);
    }

    sub setMonitor
    {
        my $self = shift;
        $self->closeFilehandles(qw/toMon fromMon/);
    }

    sub supportsConcurrency
    {
        return 1;
    }

    # First parameter is the ipc Type of the message to send.
    # Second parameter is the module name (or other message).
    # Third parameter is the file handle id to send on.
    sub sendMessage
    {
        my $self = shift;
        my ($msg, $fh) = @_;

        return syswrite ($self->{$fh}, $msg);
    }

    # Override of sendIPCMessage to specify which filehandle to send to.
    sub sendIPCMessage
    {
        my $self = shift;
        push @_, 'toMon'; # Add filehandle to args.

        return $self->SUPER::sendIPCMessage(@_);
    }

    # Used by monitor process, so no message encoding or decoding required.
    sub sendToBuilder
    {
        my ($self, $msg) = @_;
        return $self->sendMessage($msg, 'toBuild');
    }

    # First parameter is a reference to the output buffer.
    # Second parameter is the id of the filehandle to read from.
    sub receiveMessage
    {
        my $self = shift;
        my $fh = shift;
        my $value;

        undef $!; # Clear error marker
        my $result = sysread ($self->{$fh}, $value, 256);

        return undef if not $result;
        return $value;
    }

    # Override of receiveIPCMessage to specify which filehandle to receive from.
    sub receiveIPCMessage
    {
        my $self = shift;
        push @_, 'fromMon'; # Add filehandle to args.

        return $self->SUPER::receiveIPCMessage(@_);
    }

    # Used by monitor process, so no message encoding or decoding required.
    sub receiveFromUpdater
    {
        my $self = shift;
        return $self->receiveMessage('fromSvn');
    }
}

# Dummy IPC module in case SysVIPC doesn't work.
{
    package NullIPC;

    our @ISA = qw(BaseIPC);

    sub new
    {
        my $class = shift;
        my $self = $class->SUPER::new;

        $self->{'msgList'} = []; # List of messages.
        return bless $self, $class; # OOP in Perl is so completely retarded
    }

    sub sendMessage
    {
        my $self = shift;
        my $msg = shift;

        push @{$self->{'msgList'}}, $msg;
        return 1;
    }

    sub receiveMessage
    {
        my $self = shift;

        return undef unless scalar @{$self->{'msgList'}} > 0;

        return shift @{$self->{'msgList'}};
    }
}

# 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 uninstall/;
my %fail_lists = (
    'build'   => [ ],
    'install' => [ ],
    'uninstall'=>[ ],
    'update'  => [ ],
);

my $run_mode = 'build'; # Determines if updating, building, installing, etc.
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 = ("./kdesrc-buildrc", "$ENV{HOME}/.kdesrc-buildrc",
               "./kdesvn-buildrc", "$ENV{HOME}/.kdesvn-buildrc");
my $rcfile; # the file that was used; set by read_options
my @screen_log;

# 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";

    push(@screen_log, join("\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;
}

sub error(@)
{
    print STDERR (clr $_) foreach (@_);
    print STDERR (clr "]\n");
}

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.    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;
}

# This subroutine acts like split(' ', $_) except that double-quoted strings are not split in
# the process.  Patch provided by Alain Boyer (alainboyer@gmail.com) based on a posting at
# http://www.perlmonks.org/?node_id=212174.  Converted to an extended RE for readability by
# mpyne.
#
# Note: This only works if the quotes completely surround the parameter in question.
# i.e. "a=-DFOO -DBAR" works, a="-DFOO -DBAR" does not.
#
# First parameter: String to split on whitespace.
# Return value: A list of the individual words and quoted values in the string.
sub split_quoted_on_whitespace($)
{
    my $str = shift;
    my @words = $str =~
      /\s*     # Eat up whitespace
       "?      # Match 0-1 quotes
       (       # Open grouping expression
        (?<!") #   Match everything not following " (i.e. there was no quote)
        \S+    #   Followed by 1 or more non-whitespace (this breaks on whitespace)
        (?<!") #   Match everything not following " (don't read over a quote on accident)
        |      #  or
        [^"]+  #   All non-quote characters (After reading a quote)
       )       # End grouping expression
       "?      # Followed by 0-1 quotes
       \s*     # Eat up whitespace
      /xg; # g modifier repeats the match as often as possible to get all matches.

    return @words;
}

# Subroutine that returns the path of a file used to output the log messages
#
# All files will be stored in the log directory.
sub get_screen_log_file
{
    return get_log_dir('global') . "/build-log";
}

# Subroutine to retrieve a subdirectory 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 $kdesrcdir.
        my $kdesrcdir = get_option($module, 'source-dir');
        $dir = "$kdesrcdir/$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;
}

# This function returns true if the give module uses CMake.  If the user has
# specified a choice, we use the user's choice regardless for now.  If no user
# choice is given, auto-detect based on searching for filenames.
#
# First parameter: Module to check.
# Return: True (non-zero) if user has chosen cmake or CMake support is detected,
#         False (0, undef) if user does not want cmake or no CMake support is detected.
sub module_uses_cmake
{
    my $module = shift;

    my $srcdir = get_fullpath($module, 'source');
    return 1 if -e "$srcdir/CMakeLists.txt";

    # Kind of a hack but it beats inventing a sequence of checks that happens
    # to get it right: just hardcode in the module that is the exception to the
    # rule.

    return 1 if $module =~ /^l10n-kde4\/?/;

    # No CMakeLists?  Expected for qt-copy
    return 0 if $module eq 'qt-copy';

    # No CMakeLists.txt found, if the directory existed don't use CMake,
    # otherwise assume we are using CMake for now.

    return not -e $srcdir;
}

# Convenience subroutine to get the source root dir.
sub get_source_dir
{
    my $module = shift;
    $module = 'global' unless defined $module;

    return get_subdir_path ($module, '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: 'kdelibs'  => 'branches/KDE'
#     'kdevelop' => 'branches/kdevelop'
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.
    my @kde_module_list = ((map {'kde' . $_} qw/accessibility
            addons admin artwork base bindings edu games graphics libs
            multimedia network pim pimlibs plasma-addons sdk toys utils webdev/));

    # If the user already has the module in the form KDE/foo, it's already
    # done.
    return "$type/KDE" if $module =~ /^KDE\//;

    # KDE proper modules seem to use this pattern.
    return "$type/KDE" if list_has(@kde_module_list, $module);

    # KDE extragear / playground modules use this pattern
    return "$type" if has_base_module($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');
    }

    # qt-copy is referred to as qt in svn when dealing with branches and tags.
    $branch = branch_prefix('qt', $type) if $module eq 'qt-copy';

    # Remove trailing slashes.
    $svn_server =~ s/\/*$//;

    # Remove KDE/ prefix for module name.
    $module = moduleBaseName($module);

    # KDE modules have a different module naming scheme than the rest it seems.
    return "$svn_server/$branch/$branchname/$module" if $branch =~ /\/KDE\/?$/;

    # Non-trunk translations happen in a single branch. Assume all non-trunk global
    # branches are intended for the stable translations.
    return "$svn_server/branches/stable/$module" if ($module =~ /^l10n-kde4\/?/ && $branch ne 'trunk');

    # Otherwise don't append the module name by default since it makes more
    # sense to branch this way in many situations (i.e. kdesupport tags, phonon)
    return "$svn_server/$branch/$branchname";
}

# Subroutine to return the appropriate SVN URL for a given module, based on
# the user settings.  For example, 'kdelibs' -> https://svn.kde.org/home/kde/trunk/KDE/kdelibs
#
# This operates under a double hierarchy:
# 1. If any module-specific option is present, it wins.
# 2. If only global options are present, the order override-url, tag, branch, module-base-path,
#    is preferred.
sub svn_module_url
{
    my $module = shift;
    my $svn_server = get_option($module, 'svn-server');
    my $modulePath;

    foreach my $levelLimit ('module', 'allow-inherit') {
        $modulePath = get_option($module, 'module-base-path', $levelLimit);

        # Allow user to override normal processing of the module in a few ways,
        # to make it easier to still be able to use kdesrc-build even when I
        # can't be there to manually update every little special case.
        if(get_option($module, 'override-url', $levelLimit))
        {
            return get_option($module, 'override-url', $levelLimit);
        }

        if(get_option($module, 'tag', $levelLimit))
        {
            return handle_branch_tag_option($module, 'tags');
        }

        # Note we check for 'trunk', not default_module_branch().  We handle 'trunk' in the
        # rest of the code path, any branch (even if default) should be handled in
        # handle_branch_tag_option().
        my $branch = get_option($module, 'branch', $levelLimit);
        if($branch and $branch ne 'trunk')
        {
            return handle_branch_tag_option($module, 'branches');
        }

        # This isn't true nowadays, but *is* true for older versions of phonon which
        # were developed in subversion.
        if($module eq 'phonon')
        {
            $module = 'kdesupport/phonon';
        }

        # We can't use get_option($module) after this if we have to trim the module
        # name.
        $module = moduleBaseName($module);

        # The following modules are in /trunk, not /trunk/KDE.  There are others,
        # but these are the important ones.
        my @non_trunk_modules = qw(extragear kdesupport koffice icecream kde-common
            playground qt-copy KDE kdereview www l10n-kde4);

        my $module_root = $module;
        $module_root =~ s/\/.*//; # Remove everything after the first slash

        if (not $modulePath and $levelLimit eq 'allow-inherit')
        {
            $modulePath = "trunk/KDE/$module";
            $modulePath = "trunk/$module" if list_has(@non_trunk_modules, $module_root);
            $modulePath =~ s/^\/*//; # Eliminate / at beginning of string.
            $modulePath =~ s/\/*$//; # Likewise at the end.
        }

        last if $modulePath;
    }

    # Remove trailing slashes.
    $svn_server =~ s/\/*$//;

    # Note that the module name is no longer appended if module-base-path is used (i.e.
    # $branch variable was set.  This is a change as of version 1.8.
    return "$svn_server/$modulePath";
}

# Returns true if the Net::HTTP module is available.
BEGIN {
    my $Net_HTTP_available = undef;

    sub has_Net_HTTP
    {
        return $Net_HTTP_available if defined $Net_HTTP_available;

        eval {
            require Net::HTTP;
            $Net_HTTP_available = 1;
        } or do {
            error " y[*] Can't open y[b[Net::HTTP] module, skipping check for module snapshot.";
            debug "Error was $@";
            $Net_HTTP_available = 0;
        };

        return $Net_HTTP_available;
    }
}

# Convenience subroutine to return the build directory for a module. Use
# this instead of get_subdir_path because this special-cases modules for you,
# (if necessary).
#
# The returned value does not include the module name at the end (as the build
# path on disk doesn't always use the module name given in the .kdesrc-buildrc),
# so be sure to add on the module name if needed.
sub get_build_dir
{
    my $module = shift;

    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';

    return $logpath if pretending;

    debug "Log directory for $module is $logpath";

    if (not -e $logpath and not super_mkdir($logpath))
    {
        error "Unable to create log directory r[$logpath]";
        return undef;
    }

    # Don't mess with Texas^H^H^H^H^Hsymlinks for 'global'
    return $logpath if $module eq 'global';

    # Add a symlink to the latest run for this module.  Previous kdesrc-build
    # releases would use /latest as a symlink, but this made it hard to find
    # the last run on e.g.  kdebindings if you built kdebase alone last time.
    # So now latest is a directory that holds module symlinks.  We do need to
    # be careful of modules that have multiple directory names though (like
    # extragear/foo).

    # This operation should be atomic in async mode since the update thread
    # should create the log dir before it is needed by the build thread (which
    # will not have to unlink/symlink).
    if (-l "$logbase/latest")
    {
        # Remove old-style symlink
        unlink("$logbase/latest");
    }

    if (not -e "$logbase/latest")
    {
        mkdir("$logbase/latest");
    }

    # Handle stuff like playground/utils or KDE/kdelibs
    my ($moduleName, $modulePath) = fileparse($module);

    # Setup directory path we need to create.
    my $latestPath = "$logbase/latest";

    # If we have a path separator we need to adjust and create dirs and stuff
    if ($module =~ /\//)
    {
        $latestPath .= "/$modulePath";
        super_mkdir($latestPath);
    }
    else
    {
        $moduleName = $module; # This just makes later stuff easier
    }

    my $symlinkTarget = "$logbase/$LOG_DATE-$BUILD_ID/$module";
    my $symlink = "$latestPath/$moduleName";

    if (-l $symlink and readlink($symlink) ne $symlinkTarget)
    {
        unlink($symlink);
        symlink($symlinkTarget, $symlink);
    }
    elsif(not -e $symlink)
    {
        # Create symlink initially if we've never done it before.
        symlink($symlinkTarget, $symlink);
    }

    return $logpath;
}

# This subroutine returns an option value for a given module.  Some
# globals can't be overridden by a module's choice.  If so, the
# module's choice will be ignored, and a warning will be issued.
#
# Option names are case-sensitive!
#
# First parameter: Name of module
# Second paramenter: Name of option
# Third parameter: Level limit (optional). If not present, then the value
# 'allow-inherit' is used. Options:
#   - allow-inherit: Module is used if present (with exceptions), otherwise
#     global is used.
#   - module: Only module is used (if you want only global then use a module of 'global')
sub get_option
{
    my $module = shift;
    my $option = shift;
    my $levelLimit = shift;
    my $globalOpts = $package_opts{'global'};
    my @lockedOpts = qw(pretend disable-agent-check);

    # Default value
    $levelLimit = 'allow-inherit' unless defined $levelLimit;

    # These options can't override globals
    if (list_has(@lockedOpts, $option) or $module eq 'global')
    {
        return ${$globalOpts}{"#$option"} if exists ${$globalOpts}{"#$option"};
        return ${$globalOpts}{$option};
    }

    # Some global options would probably make no sense applied to qt-copy.
    my @qtCopyOverrides = qw(branch configure-flags tag);
    $levelLimit = 'module' if ($module eq 'qt-copy' && list_has(@qtCopyOverrides, $option));

    # Ensure levelLimit is not broken
    my @validLevelLimits = qw(allow-inherit module);
    if (not list_has(@validLevelLimits, $levelLimit))
    {
        die "Invalid level limit $levelLimit passed to get_option";
    }

    my $ref = $package_opts{$module};

    # Check for a sticky option
    return $$ref{"#$option"} if exists $$ref{"#$option"};

    # If we are limited to module options then find it and return it
    return $$ref{$option} if $levelLimit eq 'module';

    # Otherwise, keep going in order of precedence
    return ${$globalOpts}{"#$option"} if defined ${$globalOpts}{"#$option"};

    # No sticky options left.
    # cmake options and CXXFLAGS are appended to the global option
    if ($module ne 'qt-copy' && ($option eq 'cxxflags' || $option eq 'cmake-options'))
    {
        my $value = ${$globalOpts}{$option};

        if(defined $$ref{$option})
        {
            my $modvalue = $$ref{$option};
            $value .= " $modvalue";
        }

        return $value;
    }

    # qt-copy should already have default options set, no need to check
    # specifically for it.  We still may need to prevent returning a set global
    # option when the default is unset.

    # 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 ${$globalOpts}{$option};
}

# Returns a Perl object worth "die"ing for. (i.e. can be given to the die
# function and handled appropriately later with an eval). The returned
# reference will be an instance of BuildException. The actual exception type is
# passed in as the first parameter (as a string), and can be retrieved from the
# object later using the 'exception_type' key, and the message is returned as
# 'message'
#
# First parameter: Exception type
# Second parameter: Message to show to user
# Return: Reference to the exception object suitable for giving to "die"
sub make_exception
{
    my $exception_type = shift;
    my $message = shift;

    $exception_type = 'Exception' unless defined $exception_type;

    my $obj = eval {
        package BuildException;
        my $new_obj = {'exception_type' => $exception_type,
                       'message'        => $message };
        bless($new_obj);
        return $new_obj;
    };

    return $obj;
}

# Returns a string describing the scm platform of the given module.
#
# First parameter: Module to get scm type of.
# Returns: 'git' or 'svn' at this point.
sub module_scm_type
{
    my $module = shift;

    # If it needs a repo it's git. Everything else is svn for now.
    return 'git' if get_option($module, 'repository');
    return 'svn';
}

# Subroutine used to handle the checkout-only option.  It handles
# updating subdirectories of an already-checked-out module.
#
# This function can throw an exception in the event of a update failure.
#
# First parameter is the module.
# All remaining parameters are subdirectories to check out.
#
# Returns the number of files changed by the update, or undef if unable to
# be determined.
sub update_module_subdirectories
{
    my $module = shift;
    my $numChanged = 0;

    # If we have elements in @path, download them now
    for my $dir (@_)
    {
        info "\tUpdating g[$dir]";

        my $logname = $dir;
        $logname =~ tr{/}{-};

        my $count = run_svn($module, "svn-up-$logname", [ 'svn', 'up', $dir ]);
        $numChanged = undef unless defined $count;
        $numChanged += $count if defined $numChanged;
    }

    return $numChanged;
}

# 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/kdelibs', and no change in the dest-dir
# option, you'd get something like:
# {
#   'path'     => '/home/user/kdesrc/KDE',
#   'module'   => 'kdelibs',
#   'fullpath' => '/home/user/kdesrc/KDE/kdelibs'
# }
# If dest-dir were changed to e.g. extragear-multimedia, you'd get:
# {
#   'path'     => '/home/user/kdesrc',
#   'module'   => 'extragear-multimedia',
#   'fullpath' => '/home/user/kdesrc/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_source_dir($module);
    $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'};
}

# This subroutine downloads the specified file from a host, and saves it to the
# given filename.
#
# First parameter: Hostname of the server (i.e. kdesrc-build.kde.org)
# Second parameter: Path of the file on the host (i.e. /files/blah.tbz2)
# Third parameter: Filename to save as (i.e. $ENV{HOME}/blah.tbz2)
# Fourth parameter: Reference to hash used to record if a redirection occurred,
#                   and how many redirections have already been attempted.
#                   See download_file()
# Return value is 0 for failure, non-zero for success.
sub download_http_file
{
    my ($host, $path, $filename, $info) = @_;

    return 0 unless has_Net_HTTP();
    my $conn = Net::HTTP->new (Host => $host);

    if (not defined $conn)
    {
        error "Unable to connect to snapshot host: r[$@]";

        return 0;
    }

    debug "Checking for $path";

    # Send connection request
    $conn->write_request('GET' => "$path",
                         'User-Agent' => "Mozilla/5.0 (compatible; kdesrc-build $versionNum)",
                         );

    my ($code, $msg, %h) = $conn->read_response_headers();

    # Try to handle redirections.  We handle them all pretty much the same,
    # i.e. if the Location response is present use that, otherwise error out.
    while (int $code / 100 == 3)
    {
        $info->{'redir_count'}++;
        $conn->close(); # Error or not, we're done with this connection.

        if (not $h{'Location'})
        {
            error "Unable to download file r[$path], ambiguous redirection.";
            return 0;
        }

        my $destination = $h{'Location'};
        $destination =~ s/^Location:\s*//;
        $info->{'redirection'} = $destination;
        return 0;
    }

    if (200 != $code)
    {
        error "Unable to download file r[$path]:\n\tr[b[$msg]";

        $conn->close();
        return 0;
    }

    open OUTPUT, ">$filename" or do {
        error "Unable to open output file for r[$path] download.";
        error "\tMessage: b[r[$@]";

        $conn->close();
        return 0;
    };

    my ($buf, $result);
    while (1)
    {
        $result = $conn->read_entity_body($buf, 2048);
        if (not defined $result)
        {
            error "Error downloading from host: r[$!]";

            $conn->close();
            close OUTPUT;
            safe_unlink($filename);

            return 0;
        }

        last unless $result; # Break loop if end-of-data
        print OUTPUT $buf;   # Print downloaded data to file.
    }

    close OUTPUT;
    $conn->close();

    return 1;
}

# This subroutine downloads the file pointed to by the URL given in the first
# parameter, saving to the given filename.  (FILENAME, not directory).
#
# First parameter: FTP Host. (i.e. ftp.kde.org)
# Second parameter: Path to file, including file name (i.e. /pub/unstable/foo.tbz2)
# Third parameter: Filename to save as (i.e. $ENV{HOME}/blah.tbz2)
# Return value is 0 for failure, non-zero for success.
sub download_ftp_file
{
    my ($host, $path, $filename) = @_;

    # Detect Net::FTP.
    my $ftp;
    eval {
        require Net::FTP;
    } or do {
        error " y[*] Can't open y[b[Net::FTP] module, skipping check of g[ftp.kde.org].";
        debug "Error was $@";
        return 0;
    };

    $ftp = new Net::FTP($host, Timeout => 30);

    if (not $ftp)
    {
        error "Unable to connect to snapshot host $host: r[$@]";
        return 0;
    }

    if (not $ftp->login())
    {
        error "Connection refused to FTP host r[$host], skipping snapshot.";
        error "FTP response: $ftp->message";
        return 0;
    }

    $ftp->binary(); # Switch to binary mode.

    # Check if file exists.
    my $size = $ftp->size($path);
    if (not $size or $size <= 0)
    {
        $ftp->quit();
        return 0;
    }

    if (not defined $ftp->get($path, $filename))
    {
        # Download failed.
        error "Unable to download snapshot from r[$host].";
        return 0;
    }

    $ftp->quit();
    return 1;
}

# This subroutine downloads the file pointed to by the URL given in the first
# parameter, saving to the given filename.  (FILENAME, not directory). HTTP
# and FTP are supported, depending on if the required Net::HTTP and Net::FTP
# modules are available.
#
# First parameter: URL of link to download (i.e. http://kdesrc-build.kde.org/foo.tbz2)
# Second parameter: Filename to save as (i.e. $ENV{HOME}/blah.tbz2)
# Return value is 0 for failure, non-zero for success.
sub download_file
{
    my $url = shift;
    my $filename = shift;

    if (pretending)
    {
        pretend "Would have downloaded g[$url]\n\tto g[$filename]";
        return 1;
    }

    my ($protocol, $host, $path);
    my $info = { 'redir_count' => 0, 'redirection' => '' };

    while ($info->{'redir_count'} < 5)
    {
        ($protocol, $host, $path) = ($url =~ m{^([^:]+)://([^/]+)(/.*)$});
        if (not defined $url or not defined $host or not defined $path)
        {
            error "Trying to download file from invalid URL: r[$url]";
            return 0;
        }

        $info->{'redirection'} = '';

        # Not sure if https works but no harm in letting it try.
        if ($protocol =~ /^https?$/)
        {
            whisper "Downloading g[$path] from g[$url]";
            my $result = download_http_file($host, $path, $filename, $info);

            if (not $result and $info->{'redirection'})
            {
                # Try again at new URL.
                $url = $info->{'redirection'};
                whisper "Redirecting to y[$url]";
                next;
            }
            else
            {
                return $result;
            }
        }
        elsif ($protocol eq 'ftp')
        {
            whisper "Downloading g[$path] from g[$url]";
            return download_ftp_file($host, $path, $filename);
        }
        else
        {
            error "Trying to download file ($url), but";
            error "\tthe r[$protocol] protocol is unsupported.";
            return 0;
        }
    }

    return 0;
}

# This subroutine is used to try and download a Subversion checkout snapshot
# for a given module.  Modules that have branches or tags associated with them
# are not attempted.
#
# If available the snapshot is downloaded and installed into the normal
# location for a kdesrc-build source checkout and already switched into the
# correct svn-server setting.
#
# The first parameter is the module to download.
# Return value is boolean true if successful, false otherwise.
sub install_module_snapshot
{
    my $module = shift;

    whisper "Finding snapshot for g[$module]";

    # Don't bother with snapshot if the user has their own URL picked out.
    if (get_option($module, 'override-url') or
        get_option($module, 'module-base-path') or
        module_scm_type($module) eq 'git')
    {
        return 0;
    }

    my $moduleName = moduleBaseName($module); # KDE/kdelibs -> kdelibs

    # The branch for the module is the tag option if specified, otherwise the
    # branch option if specified.  Otherwise the default branch for the
    # module is selected (usually trunk, perhaps 4.3)
    my $branch = get_option($module, 'tag');

    # FIXME: This is broken for kdesupport (since it is default tags) but should magically
    # work since there will be no snapshot available.
    $branch = get_svn_branch($module) if not $branch;

    my ($filename, $url, $dirName);

    # If a trunk module, try to obtain from KDE FTP first.
    return 0 if ($branch ne 'trunk');

    $filename = "$moduleName-svn.tar.bz2";
    $filename =~ tr{/}{-}; # Substitute - for /
    $dirName = $moduleName;

    if ($filename =~ /^(playground|extragear)-/)
    {
        $filename = "kde$filename"; # Conform to snapshot naming convention
        $dirName = "kde$moduleName";
        $dirName =~ s{/}{-}; # Substitute here too.
    }

    $url = "http://download.kde.org/download.php?url=unstable/snapshots/$filename";

    return download_module_snapshot($module, $filename, $url, $dirName);
}

# This subroutine tries to download a Subversion checkout snapshot of a given
# module (and it actually handles the downloading).  If the download succeeds,
# this function will automatically arrange the extracted module to fit the
# normal kdesrc-build source layout, and take the necessary steps to restore
# the snapshot to a state as if it had just been checked out from Subversion.
#
# The finalized Subversion checked will then have svn up run in order to
# complete the checkout.
#
# If a failure occurs, the function will try to clean up after itself.  So,
# no snapshot tarball or module directory should be present if 0 is returned.
#
# The first parameter is the module to download.
# The second parameter is the filename to use.
# The third parameter is the URL to download.
# The fourth parameter is the final directory name from the extracted tarball.
#
# Return value is boolean true if successful, false otherwise.
sub download_module_snapshot
{
    my ($module, $filename, $url, $dirName) = @_;
    my %pathinfo = get_module_path_dir($module, 'source');

    # We are in either the source directory or $srcdir/KDE so moduleBaseName
    # is always the right directory name.

    if (pretending)
    {
        pretend "Would have tried downloaded snapshot for g[$module], from";
        pretend "\tb[g[$url]";
        return 0; # Assume failure since pretending.
    }

    info "Downloading snapshot for g[$module]";

    if (not download_file($url, $filename))
    {
        error "Unable to download snapshot for module r[$module]";
        return 0;
    }

    info "\tDownload complete for g[$module], completing snapshot.";

    # Now extract the newly downloaded file. First decompress it. (Don't
    # use the j flag as it doesn't appear to be portable.
    my $result = safe_system('bunzip2', $filename);
    if($result) { # failure
        error "Unable to decompress snapshot for r[$module]: $!";

        # Clean up the probably defective snapshot.
        safe_unlink($filename);

        return 0;
    }

    # The file doesn't end in .bz2 anymore.
    $filename =~ s/\.bz2$//;

    # Extract the file.
    $result = safe_system("tar", "xf", $filename);
    my $savedError = $!; # Make sure safe_unlink doesn't overwrite.

    # Snapshot file is no longer necessary.
    safe_unlink($filename);

    if($result) { # failure
        error "Unable to extract snapshot for r[$module]: $savedError";

        # Remove any created portions of the module tree.
        safe_rmtree($dirName);

        return 0;
    }

    whisper "\tExtracted directory for g[$module]";

    # The extracted directory is possibly of a weird form, move it to the
    # correct name (just $pathinfo{'module'});
    if($dirName ne $pathinfo{'module'} and not safe_rename($dirName, $pathinfo{'module'})) {
        error "Unable to move directory for r[$module] into place: r[$!]";

        # Remove any created portions of the module tree.
        safe_rmtree($dirName);
        safe_rmtree($pathinfo{'module'});

        return 0;
    }

    whisper "\tg[$module] snapshot is in place.";

    # Module in place, now prepare it for checkout.
    p_chdir($pathinfo{'module'});

    # Switch svn host to proper host.
    my $svnHost = get_option($module, 'svn-server');
    my $curSvnHost = get_repo_url($module);
    $curSvnHost =~ s/\/home\/kde.*$/\/home\/kde/; # Remove stuff after /home/kde

    info "\tFinalizing Subversion information for g[$module]";

    # Set svn snapshot to update from the correct svn host instead of the default
    # anonsvn (if different).
    if($svnHost ne $curSvnHost)
    {
        $result = log_command($module, 'svn-snapshot-switch',
            ['svn', 'switch', '--relocate', $curSvnHost, $svnHost]);

        if($result)
        {
            error "Unable to switch snapshot Subversion source to the KDE Subversion server!";
            error "\tr[$!]";

            # Remove any created portions of the module tree.
            p_chdir($pathinfo{'path'});
            safe_rmtree($pathinfo{'module'});

            return 0;
        }
    }
    else
    {
        debug "Skipping svn switch step, it is unnecessary.";
    }

    whisper "\tRestoring module file layout to normal.";

    # Finally, restore the file structure.
    $result = log_command($module, 'svn-restore-checkout',
        [ 'svn', 'revert', '-R', '.' ]);

    if($result)
    {
        error "Unable to restore standard Subversion layout!";

        # Remove any created portions of the module tree.
        p_chdir($pathinfo{'path'});
        safe_rmtree($pathinfo{'module'});

        return 0;
    }

    info "Snapshot checkout complete, g[$module] at snapshot's revision.";
    info "\nCompleting checkout by updating g[$module]";

    $result = log_command($module, 'svn-first-up', ['svn', 'up']);
    if($result)
    {
        error "Unable to update module r[$module] to latest code.  The module";
        error "is correctly checked-out however, so it may be possible to try";
        error "again later.";

        # Don't delete anything here, we're close enough to being good that
        # kdesrc-build should be able to fix this later.
        return 1;
    }

    info "Checkout complete for g[$module]!";

    return 1;
}

# This subroutine is responsible for stripping the KDE/ part from the beginning
# of modules that were entered by the user like "KDE/kdelibs" instead of the
# normal "kdelibs".  That way you can search for kdelibs without having to
# strip KDE/ everywhere.
sub moduleBaseName
{
    my $module = shift;
    $module =~ s/^KDE\///;

    return $module;
}

# Returns the user-selected branch for the given module, or 'master' if no
# branch was selected.
#
# First parameter is the module name.
sub get_git_branch
{
    my $module = shift;
    my $branch = get_option($module, 'branch');

    $branch = 'master' unless $branch;
    return $branch;
}

# Returns the current sha1 of the given git "commit-ish".
sub git_commit_id
{
    my $commit = shift;
    $commit = 'HEAD' unless $commit;

    my $id = `git rev-parse $commit` or die "Can't parse git commit $commit";
    chomp $id;

    return $id;
}

# Returns the number of lines in the output of the given command. The command
# and all required arguments should be passed as a normal list, and the current
# directory should already be set as appropriate.
#
# Return value is the number of lines of output.
# Exceptions are raised if the command could not be run.
sub count_command_output
{
    my @args = @_;

    open(my $fh, '-|', @args);
    my $count = 0;

    $count++ while(<$fh>);
    close $fh;
    return $count;
}

# Returns the first valid value among the following (for the given module,
# assumed to be a Subversion module):
# 1. User's selected branch option
# 2. Default branch option (if non-empty)
# 3. 'trunk'
#
# First parameter is the module name.
sub get_svn_branch
{
    my $module = shift;
    my $branch = get_option($module, 'branch');
    $branch = default_module_branch($module) unless $branch;
    $branch = 'trunk' unless $branch;

    return $branch;
}

# Perform a git clone to checkout the latest branch of a given git module
#
# Afterwards a special remote name is setup for later usage
# (__kdesvn-build-remote). This name is retained due to its historical usage.
#
# First parameter is the module to perform the checkout of.
# Second parameter is the repository (typically URL) to use.
# Returns boolean true if successful, false otherwise.
sub git_clone_module
{
    my $module = shift;
    my $git_repo = shift;
    my $srcdir = get_fullpath($module, 'source');
    my @args = ('--', $git_repo, $srcdir);

    # The -v forces progress output from git, which seems to work around either
    # a gitorious.org bug causing timeout errors after cloning large
    # repositories (such as qt-copy...)
    unshift (@args, '-v') if $module eq 'qt-copy';

    note "Cloning g[$module]";

    my $result = log_command($module, 'git-clone', ['git', 'clone', @args]);
    if ($result == 0) {
        set_persistent_option($module, 'git-cloned-repository', $git_repo);
    }

    return ($result == 0);
}

# Returns boolean true if the git checkout for the current source directory
# contains a specified branch name. No processing of the branch name is
# performed, so if you need to check for a remote head, use something like
# "refs/remotes/$remote/$branch".
#
# First parameter is the branch name.
sub git_has_branch
{
    my $branch = shift;

    # system() is used instead of safe_system since we'd like pretend output
    # to reflect reality.
    my $result = system(qw(git show-ref --verify --quiet), $branch);
    return ($result == 0);
}

# Returns true if the git module in the current directory has a remote of the
# name given by the first parameter.
sub git_has_remote
{
    my $remote = shift;

    open my $output, '-|', qw(git remote);
    my @remotes = grep { /^$remote/ } (<$output>);
    close $output;

    return @remotes > 0;
}

# We use a very-oddly-named remote name for the situations where we don't care
# about user interaction with git. However 99% of the time the 'origin' remote
# will be what we want anyways, and 0.5% of the rest the user will have
# manually added a remote, which we should try to utilize when doing checkouts
# for instance. To aid in this, this subroutine returns a list of all
# remote aliased matching the supplied repository (besides the internal
# alias that is).
#
# Assumes that we are already in the proper source directory.
#
# First parameter: Repository URL to match.
# Returns: A list of matching remote names (list in case the user hates us
# and has aliased more than one remote to the same repo). Obviously the list
# will be empty if no remote names were found.
sub git_get_best_remote_names
{
    my $repoUrl = shift;
    my @outputs;

    # The Repo URL isn't much good, let's find a remote name to use it with.
    # We'd have to escape the repo URL to pass it to Git, which I don't trust,
    # so we just look for all remotes and make sure the URL matches afterwards.
    eval {
        @outputs = slurp_git_config_output(
            qw/git config --null --get-regexp remote\..*\.url ./
        );
    };

    if($@) {
        error "Unable to run git config, is there a setup error?";
        return ();
    }

    my @results;
    foreach my $output (@outputs) {
        # git config output between key/val is divided by newline.
        my ($remoteName, $url) = split(/\n/, $output);

        $remoteName =~ s/^remote\.//;
        $remoteName =~ s/\.url$//; # Extract the cruft

        # Skip other remotes
        next if $url ne $repoUrl;

        # Try to avoid "weird" remote names.
        next if $remoteName !~ /^[\w-]*$/;

        # A winner is this one.
        push @results, $remoteName;
    }

    # If we have more than one matching remote, make sure our ugly internal remote name
    # is removed.
    if (scalar @results > 1) {
        @results = grep { $_ ne GIT_REMOTE_ALIAS } (@results);
    }

    return @results;
}

# Generates a potential new branch name for the case where we have to setup
# a new remote-tracking branch for a repository/branch. There are several
# criteria that go into this:
# * The name will be in the style $repo-$branch to allow the user to make
#   $branch-only names.
# * The name chosen must not already exist. This methods tests for that.
# * The repo name chosen should be (ideally) a remote name that the user has
#   added. If not, we'll try to autogenerate a repo name (but not add a
#   remote!) based on the repository.git part of the URI. In no case will the
#   internal remote alias be used.
#
# As with nearly all git support functions, the git remote alias should already
# be setup, and we should be running in the source directory of the git module.
# Don't call this function unless you've already checked that a suitable
# remote-tracking branch doesn't exist.
#
# First parameter: The module being worked on.
# Second parameter: A *reference* to a list of remote names (all pointing to
#                   the same repository) which are valid.
# Third parameter: The name of the remote head we need to make a branch name
# of.
# Returns: A useful branch name that doesn't already exist, or '' if no
# name can be generated.
sub git_make_branchname
{
    my $module = shift;
    my $remoteNamesRef = shift;
    my $branch = shift;
    my $chosenName;

    # Pick the first "best" remote name, if available.
    $chosenName = $remoteNamesRef->[0] if @{$remoteNamesRef};
    return "$chosenName-$branch" if $chosenName;

    # No name chosen, assume origin.

    info " b[y[*] \tNo existing remote repository found for y[$module], assuming b[g[origin].";

    return "origin-$branch";
}

# This subroutine finds an existing remote-tracking branch name for the given repository's
# named remote. For instance if the user was using the local remote-tracking branch
# called 'qt-stable' to track kde-qt's master branch, this subroutine would return the
# branchname 'qt-stable' when passed kde-qt and 'master'.
#
# First parameter: The module we are working on.
# Second parameter: A *reference* to a list of remote names to check against.
#                   It is important that this list all really point against the
#                   same repository URL however. (See
#                   git_get_best_remote_names)
# Third parameter: The remote head name to find a local branch for.
# Returns: Empty string if no match is found, or the name of the local remote-tracking
#          branch if one exists.
sub git_get_remote_branchname
{
    my $module = shift;
    my $remoteNamesRef = shift;
    my $branchName = shift;

    # Dereference our remote names.
    my @remoteNames = @{$remoteNamesRef};

    # Look for our branchName in each possible remote alias.
    foreach my $remoteName (@remoteNames) {
        # We'll parse git config output to search for branches that have a
        # remote of $remoteName and a 'merge' of refs/heads/$branchName.

        my @branches = slurp_git_config_output(
            qw/git config --null --get-regexp branch\..*\.remote/, $remoteName
        );

        foreach my $gitBranch (@branches) {
            # The key/value is \n separated, we just want the key.
            my ($keyName) = split(/\n/, $gitBranch);
            my ($thisBranch) = ($keyName =~ m/^branch\.(.*)\.remote$/);

            # We have the local branch name, see if it points to the remote
            # branch we want.
            my @configOutput = slurp_git_config_output(
                qw/git config --null/, "branch.$thisBranch.merge"
            );

            if(@configOutput && $configOutput[0] eq "refs/heads/$branchName") {
                # We have a winner
                return $thisBranch;
            }
        }
    }

    return '';
}

# Updates an already existing git checkout by running git pull.
# Assumes the __kdesvn-build-remote git remote has been setup.
#
# First parameter is the module to download.
# Returns boolean true if successful, otherwise 0.
sub git_update_module
{
    my $module = shift;
    my $srcdir = get_fullpath($module, 'source');
    my $old_repo = get_persistent_option($module, 'git-cloned-repository');
    my $cur_repo = get_option($module, 'repository');
    my $branch = get_git_branch($module);
    my $remoteName = GIT_REMOTE_ALIAS;
    my $result;

    p_chdir($srcdir);

    note "Updating g[$module]";
    my $start_commit = git_commit_id();

    # Search for an existing remote name first. If none, add our alias.
    my @remoteNames = git_get_best_remote_names($cur_repo);

    if (@remoteNames) {
        $remoteName = $remoteNames[0];
    }
    else {
        if(git_has_remote(GIT_REMOTE_ALIAS)) {
            if(log_command($module, 'git-update-remote',
                        ['git', 'remote', 'set-url', GIT_REMOTE_ALIAS, $cur_repo])
                != 0)
            {
                die "Unable to update the fetch URL for existing remote alias for $module";
            }
        }
        elsif(log_command($module, 'git-remote-setup',
                       ['git', 'remote', 'add', GIT_REMOTE_ALIAS, $cur_repo])
            != 0)
        {
            die "Unable to add a git remote named " . GIT_REMOTE_ALIAS . " for $cur_repo";
        }

        push @remoteNames, GIT_REMOTE_ALIAS;
    }

    if ($old_repo and ($cur_repo ne $old_repo)) {
        note " y[b[*]\ty[$module]'s selected repository has changed";
        note " y[b[*]\tAttempting to perform the switch";

        # Update what we think is the current repository on-disk.
        set_persistent_option($module, 'git-cloned-repository', $cur_repo);
    }

    # Download updated objects
    # This also updates remote heads so do this before we start comparing branches
    # and such.
    if (0 != log_command($module, 'git-fetch', ['git', 'fetch', $remoteName])) {
        die "Unable to perform git fetch for $remoteName, which should be $cur_repo";
    }

    # The 'branch' option requests a given head in the user's selected
    # repository. Normally the remote head is mapped to a local branch, which
    # can have a different name. So, first we make sure the remote head is
    # actually available, and if it is we compare its SHA1 with local branches
    # to find a matching SHA1. Any local branches that are found must also be
    # remote-tracking. If this is all true we just re-use that branch,
    # otherwise we create our own remote-tracking branch.
    my $branchName = git_get_remote_branchname($module, \@remoteNames, $branch);

    if (not $branchName) {
        my $newName = git_make_branchname($module, \@remoteNames, $branch);
        whisper "\tUpdating g[$module] with new remote-tracking branch y[$newName]";
        if (0 != log_command($module, 'git-checkout-branch',
                      ['git', 'checkout', '-b', $newName, "$remoteName/$branch"]))
        {
            die "Unable to perform a git checkout of $remoteName/$branch to a local branch of $newName";
        }
    }
    else {
        whisper "\tUpdating g[$module] using existing branch g[$branchName]";
        if (0 != log_command($module, 'git-checkout-update',
                      ['git', 'checkout', $branchName]))
        {
            die "Unable to perform a git checkout to existing branch $branchName";
        }

        # If we're already on the branch just doing the checkout doesn't do
        # anything, we need to merge changes forward.
        info "\tAdvancing checkout to latest source";
        if (0 != log_command($module, 'git-merge',
                      ['git', 'merge', "$remoteName/$branch"]))
        {
            die "Unable to merge latest remote git changes into the current local git branch";
        }
    }

    my $end_commit = git_commit_id();
    return count_command_output('git', 'rev-list', "$start_commit..$end_commit");
}

# Either performs the initial checkout or updates the current git checkout for qt-copy,
# as appropriate.
#
# If errors are encountered, an exception is raised using die().
#
# Returns the number of files updated (actually it just returns 0 now, but maybe someday)
sub update_module_git_checkout
{
    my $module = shift;
    my $srcdir = get_fullpath($module, 'source');

    if (-e $srcdir) {
        # Note that this function will throw an exception on failure.
        return git_update_module($module);
    }
    else {
        my $git_repo = get_option($module, 'repository');

        if (not $git_repo) {
            die "Unable to checkout $module, you must specify a repository to use.";
        }

        git_clone_module($module, "$git_repo") or die "Can't checkout $module: $!";

        return 1 if pretending;
        return count_command_output('git', '--git-dir', "$srcdir/.git", 'ls-files');
    }

    return 0;
}

# Checkout a module that has not been checked out before, along with any
# subdirectories the user desires.
#
# This function will throw an exception in the event of a failure to update.
#
# The first parameter is the module to checkout (including extragear and
# playground modules).
# All remaining parameters are subdirectories of the module to checkout.
#
# Returns number of files affected, or undef.
sub checkout_module_path
{
    my ($module, @path) = @_;
    my %pathinfo = get_module_path_dir($module, 'source');
    my @args;

    if (not -e $pathinfo{'path'} and not super_mkdir($pathinfo{'path'}))
    {
        die clr "Unable to create path r[$pathinfo{path}]!";
    }

    p_chdir ($pathinfo{'path'});

    # First let's see if we have a snapshot checkout available.  If so, it
    # would probably be quicker to use it.
    if (not scalar @path and not get_option($module, 'disable-snapshot'))
    {
        if(install_module_snapshot($module))
        {
            whisper "Snapshot checkout successful!";
            # Success, no need to continue on this route.
            return undef;
        }
    }

    my $svn_url = svn_module_url($module);
    my $modulename = $pathinfo{'module'}; # i.e. kdelibs for KDE/kdelibs as $module

    push @args, ('svn', 'co', '--non-interactive');
    push @args, '-N' if scalar @path; # Tells svn to only update the base dir
    push @args, $svn_url;
    push @args, $modulename;

    note "Checking out g[$module]";

    my $count = run_svn($module, 'svn-co', \@args);

    p_chdir ($pathinfo{'module'}) if scalar @path;

    my $count2 = update_module_subdirectories($module, @path);

    return $count + $count2 if defined $count and defined $count2;
    return undef;
}

# Update a module that has already been checked out, along with any
# subdirectories the user desires.
#
# This function will throw an exception in the event of an update failure.
#
# The first parameter is the module to checkout (including extragear and
# playground modules).
# All remaining parameters are subdirectories of the module to checkout.
sub update_module_path
{
    my ($module, @path) = @_;
    my $fullpath = get_fullpath($module, 'source');
    my @args;

    p_chdir ($fullpath);

    eval { plugin_update_module_path($module); };

    push @args, ('svn', 'up', '--non-interactive');
    push @args, '-N' if scalar @path;

    note "Updating g[$module]";

    my $count = eval { run_svn($module, 'svn-up', \@args); };

    if($@ && $@ !~ /conflict exists/) # Update failed, try svn cleanup.
    {
        info "\tUpdate failed, trying a cleanup.";
        my $result = safe_system('svn', 'cleanup');

        die clr "Unable to update r[$module]" if $result;

        info "\tCleanup complete.";

        # Now try again (allow exception to bubble up this time).
        $count = run_svn($module, 'svn-up-2', \@args);
    }

    my $count2 = update_module_subdirectories($module, @path);

    return $count + $count2 if defined $count and defined $count2;
    return undef;
}

# The function checks whether subversion already has an ssl acceptance
# notification for svn.kde.org, and if it's doesn't, installs one.
# Problems: First off, installing any kind of "accept this ssl cert without
# user's active consent" kind of sucks.  Second, this function is very
# specific to the various signature algorithms used by svn, so it could break
# in the future.  But there's not a better way to skip warnings about svn.kde.org
# until the site has a valid ssl certificate.
#
# Accepts no arguments, has no return value.
sub install_missing_ssl_signature
{
    my $sig_dir  = "$ENV{HOME}/.subversion/auth/svn.ssl.server";
    my $sig_file = "ec08b331e2e6cabccb6c3e17a85e28ce";

    debug "Checking $sig_dir/$sig_file for KDE SSL signature.";

    if (-e "$sig_dir/$sig_file")
    {
        debug "KDE SSL Signature file present.";
        return;
    }

    debug "No KDE SSL Signature found.";
    return if pretending;

    # Now we're definitely installing, let the user know.
    warning "Installing b[y[KDE SSL signature] for Subversion.  This is to avoid";
    warning "Subversion warnings about KDE's self-signed SSL certificate for svn.kde.org";

    # Make sure the directory is created.
    if(not super_mkdir($sig_dir))
    {
        error "Unable to create r[Subversion signature] directory!";
        error "$!";

        return;
    }

    my $sig_data =
'K 10
ascii_cert
V 1216
MIIDijCCAvOgAwIBAgIJAO9Ca3rOVtgrMA0GCSqGSIb3DQEBBQUAMIGLMQswCQYDVQQGE\
wJERTEQMA4GA1UECBMHQmF2YXJpYTESMBAGA1UEBxMJTnVlcm5iZXJnMREwDwYDVQQKEw\
hLREUgZS5WLjEMMAoGA1UECxMDU1ZOMRQwEgYDVQQDEwtzdm4ua2RlLm9yZzEfMB0GCSq\
GSIb3DQEJARYQc3lzYWRtaW5Aa2RlLm9yZzAeFw0wNTA1MTExMDA4MjFaFw0xNTA1MDkx\
MDA4MjFaMIGLMQswCQYDVQQGEwJERTEQMA4GA1UECBMHQmF2YXJpYTESMBAGA1UEBxMJT\
nVlcm5iZXJnMREwDwYDVQQKEwhLREUgZS5WLjEMMAoGA1UECxMDU1ZOMRQwEgYDVQQDEw\
tzdm4ua2RlLm9yZzEfMB0GCSqGSIb3DQEJARYQc3lzYWRtaW5Aa2RlLm9yZzCBnzANBgk\
qhkiG9w0BAQEFAAOBjQAwgYkCgYEA6COuBkrEcEJMhzHajKpN/StQwr/YeXIXKwtROWEt\
7evsXBNqqRe6TuUc/iVYgBuZ4umVlJ/qJ7Q8cSa8Giuk2B3ShZx/WMSC80OfGDJ4LoWm3\
uoW8h45ExAACBlhuuSSa7MkH6EXhru1SvLbAbTcSVqyTzoWxhkAb8ujy6CUxHsCAwEAAa\
OB8zCB8DAdBgNVHQ4EFgQUx2W0046HfWi1fGL1V8NlDJvnPRkwgcAGA1UdIwSBuDCBtYA\
Ux2W0046HfWi1fGL1V8NlDJvnPRmhgZGkgY4wgYsxCzAJBgNVBAYTAkRFMRAwDgYDVQQI\
EwdCYXZhcmlhMRIwEAYDVQQHEwlOdWVybmJlcmcxETAPBgNVBAoTCEtERSBlLlYuMQwwC\
gYDVQQLEwNTVk4xFDASBgNVBAMTC3N2bi5rZGUub3JnMR8wHQYJKoZIhvcNAQkBFhBzeX\
NhZG1pbkBrZGUub3JnggkA70Jres5W2CswDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQU\
FAAOBgQDjATlL2NByFDo5hhQAQdXjSYrMxil7zcpQjR+KYVizC7yK99ZsA0LYf/Qbu/pa\
oMnmKLKWeNlF8Eq7/23TeAJmjw1pKi97ZO2FJ8jvy65iBEJLRYnpJ75dvg05iugm9GZ5w\
Px6GHZmkSrteGDXgVbbSDy5exv1naqc+qEM7Ar4Xw==
K 8
failures
V 1
8
K 15
svn:realmstring
V 23
https://svn.kde.org:443
END
';

    # Remove the \<newline> parts (the gibberish should be one big long
    # line).
    $sig_data =~ s/\\\n//gm;

    if(not open SIG, ">$sig_dir/$sig_file")
    {
        error "Unable to open KDE SSL signature file!";
        error "r[$!]";

        return;
    }

    if(not print SIG $sig_data)
    {
        error "Unable to write to KDE SSL signature file!";
        error "r[$!]";
    }

    close SIG;
}

# Subroutine to run a command, optionally filtering on the output of the child
# command.
#
# First parameter is the name of the module being built (for logging purposes
#   and such).
# Second parameter is the name of the log file to use (relative to the log
#   directory).
# Third parameter is a reference to an array with the command and its
#   arguments.  i.e. ['command', 'arg1', 'arg2']
# Fourth parameter (optional) is a reference to a subroutine to have each line
#   of child output passed to.  This output is not supposed to be printed to
#   the screen by the subroutine, normally the output is only logged.  However
#   this is useful for e.g. munging out the progress of the build.
#   USEFUL: When there is no more output from the child, the callback will be
#     called with an undef string.  (Not just empty, it is also undefined).
# The return value is the shell return code, so 0 is success, and non-zero is
#   failure.
#
# NOTE: This function has a special feature.  If the command passed into the
#   argument reference is 'kdesrc-build', then log_command will, when it forks,
#   execute the subroutine named by the second parameter rather than executing
#   a child process.  The remaining arguments in the list are passed to the
#   subroutine that is called.
sub log_command
{
    my ($module, $filename, $argRef, $callbackRef) = @_;
    my $pid;
    my @command = @{$argRef};
    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;
    }

    # Fork a child, with its stdout connected to CHILD.
    $pid = open(CHILD, '-|');
    if ($pid)
    {
        # Parent
        while (<CHILD>)
        {
            if (defined $callbackRef)
            {
                # Call callback with current output.
                &{$callbackRef}($_);
            }
            else
            {
                debug $_;
            }
        }

        close CHILD;

        # Let callback know there is no more output.
        &{$callbackRef}(undef) if defined $callbackRef;

        # 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

        # Apply altered environment variables.
        whisper "Environment altered for child";
        $ENV{$_} = $ENV_VARS{$_} foreach keys %ENV_VARS;

        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.";
        }

# The stdin redirection used to be commented out because it will cause
# problems for users using make-install-prefix when a password is desired, or
# when svn complains about the SSL signature.  I think I've fixed the latter,
# and I've decided that users should configure sudo to not need the password,
# or simply run sudo kdesrc-build instead of using make-install-prefix.  Now
# other commands will fail instead of hanging at the terminal.  As it stands, it can still
# be canceled using an exported env var just in case.

        open (STDIN, "</dev/null") unless exists $ENV{'KDESVN_BUILD_USE_TTY'};
        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.
        # In the case of git, we forced on progress output so let's leave that
        # interactive to keep the logs sane.
        open (STDERR, ">&STDOUT") unless $command[0] eq 'svn';

        # Call internal function, name given by $command[1]
        if($command[0] eq 'kdesrc-build')
        {
            # No colors!
            ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = ("") x 5;
            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; # Exit child process successfully.
        }

        # Don't leave empty output files, give an indication of the particular
        # command run. Use print to go to stdout.
        print "# kdesrc-build running: '", join("' '", @command), "'\n";

        # 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 kdesrc-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");
    debug "Logfile for $module is $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 "$logfile", "$logdir/error.log";
}

# Subroutine to run make and process the build process output in order to
# provide completion updates.  This procedure takes the same arguments as
# log_command() (described here as well), except that the callback argument is
# not used.
#
# First parameter is the name of the module being built (for logging purposes
#   and such).
# Second parameter is the name of the log file to use (relative to the log
#   directory).
# Third parameter is a reference to an array with the command and its
#   arguments.  i.e. ['command', 'arg1', 'arg2']
# The return value is the shell return code, so 0 is success, and non-zero is
#   failure.
sub run_make_command
{
    my ($module, $filename, $argRef) = @_;

    debug "run_make_command: $module, ", join(', ', @{$argRef});

    # There are situations when we don't want (or can't get) progress output:
    # 1. Not using CMake (i.e. Qt)
    # 2. If we're not printing to a terminal.
    # 3. When we're debugging (we'd interfere with debugging output).
    if ((!module_uses_cmake($module)) or not -t STDERR or debugging)
    {
        return log_command($module, $filename, $argRef);
    }

    # Setup callback function for use by log_command.
    my $last = -1;

    # w00t.  Check out the closure!  Maks would be so proud.
    my $log_command_callback = sub {
        my ($input) = shift;

        if (not defined $input)
        {
            # End of input, cleanup.
            print STDERR "\r\e[K";
        }
        else
        {
            chomp($input);

            my $percentage = '';

            if ($input =~ /^\[\s*([0-9]+)%]/)
            {
                $percentage = $1;
            }

            # Update terminal (\e[K clears to the end of line) if the
            # percentage changed.
            if ($percentage and $percentage ne $last)
            {
                print STDERR "\r$percentage% \e[K";
            }

            $last = $percentage;
        }
    };

    return log_command($module, $filename, $argRef, $log_command_callback);
}

# 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 kdebindings can't either.
sub is_subdir_buildable
{
    my ($module, $dir) = @_;

    return 0 if $dir eq 'kalyptus' and $module eq 'kdebindings';
    return 0 if $dir eq 'scripts' and ($module eq 'l10n-kde4');
    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 delete a directory and all files and subdirectories within.
# Does nothing in pretend mode.  An analogue to "rm -rf" from Linux.
# Requires File::Find module.
#
# First parameter: Path to delete
# Returns boolean true on success, boolean false for failure.
sub safe_rmtree
{
    my $path = shift;

    # Pretty user-visible path
    my $user_path = $path;
    $user_path =~ s/^$ENV{HOME}/~/;

    my $delete_file_or_dir = sub {
        # $_ is the filename/dirname.
        return if $_ eq '.' or $_ eq '..';
        if (-f $_ || -l $_)
        {
            unlink ($_) or die "Unable to delete $File::Find::name!";
        }
        elsif (-d $_)
        {
            rmdir ($File::Find::name)  or die "Unable to remove directory $File::Find::name: $!";
        }
    };

    if (pretending)
    {
        pretend "Would have removed all files/folders in $user_path";
        return 1;
    }

    # Error out because we probably have a logic error even though it would
    # delete just fine.
    if (not -d $path)
    {
        error "Cannot recursively remove $user_path, as it is not a directory.";
        return 0;
    }

    eval {
        $@ = '';
        finddepth( # finddepth does a postorder traversal.
        {
            wanted => $delete_file_or_dir,
            no_chdir => 1, # We'll end up deleting directories, so prevent this.
        }, $path);
    };

    if ($@)
    {
        error "Unable to remove directory $user_path: $@";
        return 0;
    }

    return 1;
}

# 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.
#
# Returns 0 on success, non-zero on failure (shell script style)
sub safe_make (@)
{
    my ($module, @args) = @_;
    my $logdir = get_log_dir($module);
    my $checkout_dirs = get_option($module, "checkout-only");
    my @dirs = split(' ', $checkout_dirs);
    my $install_mode = (scalar @args > 0) && ($args[0] =~ /^(un)?install$/);
    my $uninstalling = $install_mode && $args[0] eq 'uninstall';

    my $make;
    my $opts = get_option($module, 'make-options');

    # Non Linux systems can sometimes fail to build when GNU Make would work,
    # so prefer GNU Make if present, otherwise try regular make.  Also, 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.
    if(path_to_prog('gmake')) {
        $make = path_to_prog('gmake');
    }
    elsif(path_to_prog('make')) {
        $make = path_to_prog('make');
    }
    else {
        # Weird, we can't find make, you'd think configure would have
        # noticed...
        error " r[b[*] Unable to find the g[$make] executable!";
        return 1;
    }

    # Make it prettier if pretending.
    $make =~ s{^/.*/}{} if pretending;

    # Add make-options to the given options, unless we're installing (since
    # things like parallel build options will break install).
    if (not $install_mode) {
        unshift (@args, split(' ', $opts));
    }

    unshift (@args, $make);

    my $description;

    # Check if we're installing or uninstalling
    if($install_mode)
    {
        $description = clr "g[$module]";

        my @install_cmd = split(' ', get_option ($module, 'make-install-prefix'));
        if (@install_cmd)
        {
            # Add -S option if we're running sudo and it's not already
            # present.  This causes sudo to read the password from stdin (and
            # consequently fail instead of hanging at the terminal).
            if ($install_cmd[0] eq 'sudo' and not grep (/^-S$/, @install_cmd))
            {
                splice (@install_cmd, 1, 0, '-S'); # Add -S right after 'sudo'
            }

            unshift @args, @install_cmd;
        }

        if ($uninstalling) {
            info "\tUninstalling $description.";
        }
        else {
            info "\tInstalling $description.";
        }
    }
    else
    {
        info "\tCompiling...";
    }

    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);

        # The -1 used to be an increasing prefix but with CMake we don't
        # continually reattempt.  Leave the -1 for now since I expect
        # most are used to the build log ending in it.
        my $logname = $install_mode ? 'install' : "build-1";
        $logname = 'uninstall' if $uninstalling;

        if ($subdir ne '')
        {
            $logname = $install_mode ? "install-$subdir" : "build-$subdir-1";
            $logname = "uninstall-$subdir" if $uninstalling;

            # Remove slashes in favor of something else.
            $logname =~ tr{/}{-};

            if ($install_mode) {
                if ($args[0] eq 'uninstall') {
                    info "\tUninstalling subdirectory g[$subdir]";
                }
                else {
                    info "\tInstalling subdirectory g[$subdir]";
                }
            }
            else {
                info "\tBuilding subdirectory g[$subdir]";
            }
        }

        my $builddir = get_fullpath($module, 'build') . "/$subdir";
        $builddir =~ s/\/*$//; # Remove trailing /

        p_chdir ($builddir);

        my $result = run_make_command ($module, $logname, \@args );
        return $result if $result;
    };

    return 0;
}

# This function returns the default branch for a given module.  Use this function whenever
# you have to deal with checking whether the user is using the default branch.
#
# If the branch option is set globally then that value is used to come up with an
# appropriate default (usually will be the same as the branch option but not always).
#
# This function may be called while parsing options for non-global modules, so
# it can only call get_option() for 'global' entries.
#
# First parameter: module to get default branch of.
# Returns: branch name. e.g. 'trunk', '4.3', 'work/make-it-cool'
sub default_module_branch
{
    # Add the appropriate branch to this hash for stable modules.  Any module not listed
    # here will default to global{'branch'}.
    # tags/ is special as a returned module prefix as it is converted to be a
    # tag internally instead of a branch.
    my %branched_modules_exceptions = (
        # Don't integrate these kdesupport tags with the code near the end of this
        # function as the naming conventions are actually slightly different.
        '4.0' => {
            'kdesupport' => 'tags/kdesupport-for-4.1/kdesupport', # See below.
            'phonon'     => '4.2',   # Weird, I know.
        },
        '4.1' => {
            'kdesupport' => 'tags/kdesupport-for-4.1/kdesupport',
            'phonon'     => '4.2',   # Weird, I know.
        },
        '4.2' => {
            'kdesupport' => 'tags/kdesupport-for-4.2/kdesupport',
        },
        '4.3' => {
            'kdesupport' => 'tags/kdesupport-for-4.3/kdesupport',
        },
    );

    # qr() compiles a regex for use in later matching.
    my @unbranched_modules = ( qr(^extragear/), qr(^playground/), qr(^kdereview$) );

    my $module = shift;
    my $branch = get_option('global', 'branch');

    # Using git? Default to master for now.
    return 'master' if module_scm_type($module) eq 'git';

    # If the module doesn't normally get branched there's not much we can do, so we'll just
    # return the default. (We search against regexps instead of module names here)
    if (scalar grep { $module =~ $_ } @unbranched_modules)
    {
        return '';
    }

    # Some modules have a different branch name for a given KDE version, handle that.
    if (exists $branched_modules_exceptions{$branch}->{$module})
    {
        return $branched_modules_exceptions{$branch}->{$module};
    }

    # kdesupport uses a naming convention to tag required kdesupport software for
    # a release, see if we're supposed to fall under that.
    if ($module eq 'kdesupport' && $branch =~ /^\d\.\d*$/)
    {
        return "tags/kdesupport-for-$branch";
    }

    return $branch;
}

# Given a module name, this subroutine returns a hash with the default module
# options for the module.
#
# The global options must already be setup but there is no requirement for any
# module options to be available.
#
# First parameter is the module to get options for.
#
# Return is a hash reference containing the default module options, suitable
# for assignment to %package_opts.
sub default_module_options
{
    my $module = shift;
    my $branch = default_module_branch($module);
    my %options = (
        'set-env' => { },
    );
    my %module_options = (
        'qt-copy' => {
            'configure-flags' => '-qt-gif -no-phonon -dbus -nomake demos -nomake examples -fast',
            'repository' => 'git://gitorious.org/+kde-developers/qt/kde-qt.git',
            'branch'     => 'master',
        },
        'phonon' => {
            'repository' => 'git://anongit.kde.org/phonon',
        },
        'kdevplatform' => {
            # It moved recently so try to adjust gracefully (maybe) (round 2)
            'repository' => 'git://gitorious.org/kdevelop/kdevplatform.git',
        },
        'kdevelop' => {
            # It moved recently so try to adjust gracefully (maybe) (round 2)
            'repository' => 'git://gitorious.org/kdevelop/kdevelop.git',
        },
    );

    # Hack to support default "tags" instead of default branches for kdesupport.
    if ($branch =~ /^tags\//)
    {
        $branch =~ s/^tags\///; # Strip tags/
        $options{'tag'} = $branch;
    }

    # If no specific module options just return the default
    return \%options unless exists $module_options{$module};

    # Otherwise merge in options (uses Perl hash slice)
    my $this_module_options = $module_options{$module};
    @options{keys %{$this_module_options}} = values %{$this_module_options};

    return \%options;
}

# 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;

    debug "\tWould have set g[$var]=y[$val]." if pretending;

    $ENV_VARS{$var} = $val;
}

# Clears out the list of environment variables to apply to created
# subprocesses.
sub resetenv
{
    %ENV_VARS = ();
}

# Display a message to the user regarding their relative lack of
# ~/.kdesrc-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://kdesrc-build.kde.org/";

    note <<"HOME";
Unable to open configuration file!
We looked for:
    $searched

kdesrc-build will continue using a default set of options.  These options may
not apply to you, so feel free to visit the kdesrc-build homepage

b[g[$homepage]

and access the kdesrc-build documentation.  Also the latest release package
will have a sample configuration file that you can edit to your liking.

HOME
}

# This subroutine assigns the appropriate options to %package_opts and the
# update and build lists to build a default set of modules.
#
# Note: Call this and you stand the risk of losing the options you're already
# set, do this only if you need to setup options for the entire list of
# default modules.
sub setup_default_modules()
{
    # kdesupport must come before other KDE modules.
    @update_list = qw(qt-copy kdesupport phonon kdelibs kdepimlibs kdebase kdeartwork
                      kdemultimedia kdepim kdeutils kdegraphics kdegames
                      kdetoys kdeedu kdenetwork kdeutils);

    @build_list = @update_list;

    whisper "Setting up to build ", join(', ', @build_list), " by default.";

    for my $i (@update_list) {
        my $options_ref = default_module_options($i);

        # Apply default option only if option not already set.  If the option
        # is here at this point it's probably user defined on the command line
        # or setup by kdesrc-build based on an option.
        for my $key (keys %{$options_ref}) {
            if (not exists $package_opts{$i}{$key}) {
                $package_opts{$i}{$key} = $options_ref->{$key};
            }
        }
    }
}

# Reads a "line" from a file. This line is stripped of comments and extraneous
# whitespace. Also, backslash-continued multiple lines are merged into a single
# line.
#
# First parameter is the reference to the filehandle to read from.
# Returns the text of the line.
sub read_line
{
    my $fh = shift;

    while(<$fh>) {
        # Remove trailing newline
        chomp;

        # Replace \ followed by optional space at EOL and try again.
        if(s/\\\s*$//)
        {
            $_ .= <$fh>;
            redo unless eof($fh);
        }

        s/#.*$//;        # Remove comments
        next if /^\s*$/; # Skip blank lines

        return $_;
    }

    return undef;
}

# Takes an input line, and extracts it into an option name, and simplified
# value. The value has "false" converted to 0, white space simplified (like in
# Qt), and tildes (~) in what appear to be path-like entries are converted to
# the home directory path.
#
# First parameter is the input line.
# Return value is (optionname, option-value)
sub split_option_value
{
    my $input = shift;
    my $optionRE = qr/\$\{([a-zA-Z0-9-]+)\}/;

    # 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) = ($input =~ /^\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) eq 'false';

    # Replace reference to global option with their value.
    # The regex basically just matches ${option-name}.
    my ($sub_var_name) = ($value =~ $optionRE);
    while ($sub_var_name)
    {
        my $sub_var_value = get_option('global', $sub_var_name);

        if(not $sub_var_value)
        {
            my $line_no = $.;
            warning " *\n * WARNING: $sub_var_name is not set at line y[$line_no]\n *";

            $sub_var_value = '';
        }

        debug "Substituting \${$sub_var_name} with $sub_var_value";

        $value =~ s/\${$sub_var_name}/$sub_var_value/g;

        # Replace other references as well.  Keep this RE up to date with
        # the other one.
        ($sub_var_name) = ($value =~ $optionRE);
    }

    # Replace tildes with home directory.
    1 while ($value =~ s"(^|:|=)~/"$1$ENV{'HOME'}/");

    return ($option, $value);
}

# 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;

    # Setup default options in case user specifies only module name to get it
    # to build.
    if (not defined $package_opts{$module})
    {
        $package_opts{$module} = default_module_options($module);
    }

    # Read in each option
    while (read_line($fh))
    {
        if($module eq 'global')
        {
            last if /^end\s+global/; # Stop
        }
        else
        {
            last if /^end\s+module/; # Stop
        }

        # Sanity check, make sure the section is correctly terminated
        if(/^(module\s|module$)/)
        {
            error "Invalid configuration file $rcfile at line $.\nAdd an 'end module' before " .
                  "starting a new module.\n";
            die make_exception('Config', "Invalid $rcfile");
        }

        my ($option, $value) = split_option_value($_);

        # Handle special options.
        if ($module eq 'global' && $option eq 'git-repository-base') {
            # This will be a hash reference instead of a scalar
            my ($repo, $url) = ($value =~ /^([a-zA-Z0-9_-]+)\s+(.+)$/);
            $value = get_option('global', $option) || { };

            if (!$repo || !$url) {
                error <<"EOF";
The y[git-repository-base] option at y[b[$rcfile:$.]
requires a repository name and URL.

e.g. git-repository base kde git://anongit.kde.org/

Use this in a "module-set" group:

e.g.
module-set kde
  use-modules automoc akonadi soprano attica
end module-set
EOF
                die make_exception('Config', "Invalid git-repository-base");
            }

            $value->{$repo} = $url;
        }

        set_option($module, $option, $value);
    }
}

# Reads in a "moduleset".
#
# First parameter is the filehandle to the config file to read from.
# Second parameter is the name of the moduleset, which is really the name
# of the base repository to use.
# Returns the expanded list of module names to include.
sub parse_moduleset
{
    my $fh = shift;
    my $repoSet = get_option('global', 'git-repository-base');
    my @modules;
    my %optionSet; # We read all options, and apply them to all modules
    my $startLine = $.; # For later error messages

    while(read_line($fh)) {
        last if /^end\s+module(-?set)?$/;

        my ($option, $value) = split_option_value($_);

        if ($option eq 'use-modules') {
            @modules = split(' ', $value);

            if (not @modules) {
                error "No modules were selected for the current module-set";
                error "in the y[use-modules] on line $. of $rcfile";
                die make_exception('Config', 'Invalid use-modules');
            }
        }
        else {
            $optionSet{$option} = $value;
        }
    }

    if (not scalar @modules) {
        warning "No modules were defined for the module-set in r[b[$rcfile] starting at line y[b[$startLine]";
        warning "You should use the g[b[use-modules] option to make the module-set useful.";
    }

    # Setup default options for each module
    for my $module (@modules) {
        my $moduleName = $module;
        $moduleName =~ s/\.git$//; # Remove trailing .git for module name

        if (not defined $package_opts{$moduleName})
        {
            $package_opts{$moduleName} = default_module_options($moduleName);
        }

        # Apply all options in the module set to this virtual module.
        # At this point it's possible to override repository after we just
        # set it, but let's not announce that too loudly...
        for my $option (keys %optionSet) {
            my $value = $optionSet{$option};

            if ($option eq 'repository') {
                if (not exists $repoSet->{$value}) {
                    error <<EOF;
There is no repository assigned to y[b[$value] when assigning a moduleset on
line $startLine of $rcfile.

These repositories are defined by g[b[git-repository-base] in the global
section of $rcfile. Make sure you spelled your repository name right!
EOF

                    die make_exception('Config', 'Unknown repository base');
                }

                $value = $repoSet->{$value} . $module;
            }

            set_option($moduleName, $option, $value);
        }
    }

    return @modules;
}

# 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;

            # rel2abs used since path for rcfile is used later in execution
            # when the cwd may have changed so we need to expand path here.
            $rcfile = File::Spec->rel2abs($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.

If you want to force an empty rc file, use --rc-file /dev/null

EOM
            die make_exception('Runtime', "Missing $rcfiles[0]");
        }

        # Set rcfile to something so the user knows what file to edit to
        # get what they want to work.
        $rcfile = '~/.kdesrc-buildrc';
        no_config_whine();
        setup_default_modules();
        return;
    }

    my ($option, $modulename, %readModules);

    # Read in global settings
    while (<CONFIG>)
    {
        s/#.*$//;       # Remove comments
        s/^\s*//;       # Remove leading whitespace
        next if (/^\s*$/); # Skip blank lines

        # First command in .kdesrc-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 at b[r[line $.]!";
            die make_exception('Config', 'Missing global section');
        }

        # Now read in each global option
        parse_module(\*CONFIG, 'global');
        last;
    }

    my $using_default = 1;

    if (exists $ENV{"COVERITY_RUN"}) {

        info "We're being run by coverity. ignoring non global options in the";
        info "config file";

        close CONFIG;
        setup_default_modules();
        return;
    }

    # Now read in module settings
    while (<CONFIG>)
    {
        s/#.*$//;          # Remove comments
        s/^\s*//;          # Remove leading whitespace
        next if (/^\s*$/); # Skip blank lines

        my @addedModules = ();

        # Get modulename (has dash, dots, slashes, or letters/numbers)
        ($modulename) = /^module\s+([-\/\.\w]+)\s*$/;

        if (not $modulename)
        {
            if (not /^module-set\s*$/) {
                error "Invalid configuration file $rcfile!";
                error "Expecting a start of module section at r[b[line $.].";
                die make_exception('Config', 'Ungrouped/Unknown option');
            }

            # A moduleset can give us more than one module to add.
            @addedModules = parse_moduleset(\*CONFIG);
        }
        else {
            parse_module(\*CONFIG, $modulename);
            push @addedModules, $modulename;
        }

        # Don't build default modules if user has their own wishes.
        if ($using_default)
        {
            $using_default = 0;
            @update_list = @build_list = ( );
        }

        # Don't re-add duplicated modules (it may be possible to see a module
        # declaration for a module already seen in a module-set)
        @addedModules = grep { not exists $readModules{$_} } (@addedModules);

        # Done reading options, add this module(s) to the update lists
        push (@update_list, @addedModules);
        push (@build_list, @addedModules);

        # Add an entry for each module that has been read in so we don't
        # add it later to update/build list.
        @readModules{@addedModules} = 1;
    }

    close CONFIG;

    # All modules and their options have been read, filter out modules not
    # to update or build, based on the --ignore-modules option already present
    # on the command line. manual-update and manual-build are also relevant,
    # but handled in get_build_list or get_update_list.
    @update_list = grep { not exists $ignore_list{$_} } (@update_list);
    @build_list = grep { not exists $ignore_list{$_} } (@build_list);

    # 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 kdesrc-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/kdebindings/;

    # l10n/lang needs help.
    return 1 if ($module =~ /^l10n-kde4\/?/);

    # Other CMake-using modules are fine.
    return 0 if module_uses_cmake($module);

    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);
    }
}

# Sets our debugging color aliases for use at the terminal. No parameters,
# no return value.
sub set_debug_colors
{
    if(-t STDOUT and get_option('global', 'colorful-output'))
    {
        $RED = "\e[31m";
        $GREEN = "\e[32m";
        $YELLOW = "\e[33m";
        $NORMAL = "\e[0m";
        $BOLD = "\e[1m";
    }
    else
    {
        ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = ("") x 5;
    }
}

sub setup_operating_environment
{
    # Set the process priority
    setpriority PRIO_PROCESS, 0, get_option('global', 'niceness');

    # Set the IO priority if available.
    if(get_option('global', 'use-idle-io-priority')) {
        # -p $$ is our PID, -c3 is idle priority
        # 0 return value means success
        if(safe_system('ionice', '-c3', '-p', $$) != 0) {
            warning " b[y[*] Unable to lower I/O priority, continuing...";
        }
    }
}

# Subroutine to get a list of modules to uninstall, by using the command line
# if present (returned in reverse order to fool our uninstall routine), or
# the build list filtered by those modules actually installed (not in reverse
# order).
sub get_uninstall_list
{
    # Reversed since the user typed it in, to fool handle_uninstall
    return reverse @ARGV if (scalar @ARGV);

    return grep {
        defined get_persistent_option($_, 'last-install-rev')
    } (@build_list);
}

# 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.";
            die make_exception('Runtime', 'No modules can be installed, none were built.');
        }

        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');

            # async updates may cause us not to have a error log file stored.  There's only
            # one place it should be though, take advantage of side-effect of log_command()
            # to find it.
            if (not $logfile) {
                my $logdir = get_log_dir($_) . "/error.log";
                $logfile = $logdir if -e $logdir;
            }

            $logfile = "No log file" unless $logfile;
            $logfile =~ s|$homedir|~|;

            warning "r[$_]" if pretending;
            warning "r[$_] - g[$logfile]" if not pretending;
        }
    }
}

# 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);
    }

    # See if any modules fail continuously and warn specifically for them.
    my $persistent_opt = sub {
        my $mod = shift;

        return ((exists $package_opts{$mod}{'persistent-options'}{'failure-count'}) and
            (int $package_opts{$mod}{'persistent-options'}{'failure-count'} > 3));
    };

    my @super_fail = grep { &{$persistent_opt}($_) }(keys %package_opts);

    # Only show packages we're actually updating/building
    @super_fail = grep {
        list_has(@update_list, $_) or list_has(@build_list, $_)
    } (@super_fail);

    if (@super_fail)
    {
        warning "\nThe following modules have failed to build 3 or more times in a row:";
        warning "\tr[b[$_]" foreach @super_fail;
        warning "\nThere is probably a local error causing this kind of consistent failure, it";
        warning "is recommended to verify no issues on the system.\n";
    }
}

# 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};
}

# Like extract_option_value, but throws an exception if the value is not actually present,
# so you don't have to check for it yourself. If you do get a return value, it will be
# defined to something.
sub extract_option_value_required($\@)
{
    my ($option, $options_ref) = @_;
    my $returnValue = extract_option_value($option, @$options_ref);

    if (not defined $returnValue) {
        die make_exception('Runtime', "Option $option needs to be set to some value instead of left blank");
    }

    return $returnValue;
}

# 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.  To see where the warning is not a bug, go to
    # read_options() where the module-specific options are set.
    if (not exists $package_opts{$module})
    {
        $package_opts{$module} = default_module_options($module);
    }

    return if handle_set_env($package_opts{$module}, $option, $value);

    debug "  Setting $module,$option = $value";
    $package_opts{$module}{$option} = $value;

    if ($option eq 'colorful-output')
    {
        set_debug_colors(); # Update ASAP
    }
}

# Sets a "persistent" option which will be read in for a module when kdesrc-build starts
# up and written back out at (normal) program exit.
#
# First parameter is the module to set the option for, or 'global'.
# Second parameter is the name of the value to set (i.e. key)
# Third parameter is the value to store, which must be a scalar.
sub set_persistent_option
{
    my ($module, $key, $value) = @_;

    # A reference to a hash is used in the normal package_opts hash table with the
    # special key persistent-options.
    if (not exists $package_opts{$module}{'persistent-options'})
    {
        $package_opts{$module}{'persistent-options'} = { };
    }

    $package_opts{$module}{'persistent-options'}{$key} = $value;
}

# Returns the value of a "persistent" option (normally read in as part of startup), or
# undef if there is no value stored.
#
# First parameter is the module to get the option for, or 'global' if not for a module.
#     Note that unlike set_option/get_option, no inheritance is done at this point so if
#     an option is present globally but not for a module you must check both if that's what
#     you want.
# Second parameter is the name of the value to retrieve (i.e. the key)
# A scalar is always the return value.
sub get_persistent_option
{
    my ($module, $key) = @_;

    # Don't auto-vivify the value if it's not there.
    return undef unless exists $package_opts{$module}{'persistent-options'};
    return undef unless exists $package_opts{$module}{'persistent-options'}{$key};

    return $package_opts{$module}{'persistent-options'}{$key};
}

# Writes out the persistent options to the file .kdesrc-build-data.  Note: If
# the file already exists, it is only overwritten if the file contains
# "AUTOGENERATED BY kdesrc-build" in the first line in case someone actually
# used this file name before this feature was added.
#
# The directory used is the same directory that contains the rc file in use.
sub write_persistent_options
{
    return if pretending;

    my $dir = dirname($rcfile ? $rcfile : "");
    my $fh = IO::File->new("> $dir/.kdesrc-build-data");

    if (not defined $fh)
    {
        error "Unable to save persistent module data: b[r[$!]";
        return;
    }

    print $fh "# AUTOGENERATED BY kdesrc-build $versionNum\n";

    # Modules with persistent options
    my @names = grep { exists $package_opts{$_}{'persistent-options'} } keys %package_opts;

    # References to the persistent hash tables.
    my @refs = map { $package_opts{$_}{'persistent-options'} } @names;

    my %output;

    # This is a hash slice, it basically does $output{$names[i]} = $refs[i] for
    # all entries in the lists.
    @output{@names} = @refs;

    $Data::Dumper::Indent = 1;
    print $fh Data::Dumper->Dump([\%output], ["persistent_options"]);
}

# Reads in all persistent options from the file where they are kept
# (.kdesrc-build-data) for use in the program.
#
# The directory used is the same directory that contains the rc file in use.
sub read_persistent_options
{
    my $dir = dirname($rcfile ? $rcfile : "");
    my $fh = IO::File->new("<$dir/.kdesrc-build-data");

    # Don't penalize user for name change.
    $fh = IO::File->new("<$dir/.kdesvn-build-data") unless defined $fh;
    return unless defined $fh;

    my $persistent_data;
    {
        local $/ = undef; # Read in whole file with <> operator.
        $persistent_data = <$fh>;
    }

    # $persistent_data should be Perl code which, when evaluated will give us
    # a hash called persistent-options which we can then merge into our
    # package_opts.

    my $persistent_options;

    # eval must appear after declaration of $persistent_options
    eval $persistent_data;
    if ($@)
    {
        # Failed.
        error "Failed to read persistent module data: r[b[$@]";
        return;
    }

    for my $key (keys %{$persistent_options})
    {
        $package_opts{$key}{'persistent-options'} = ${$persistent_options}{$key};
    }
}

# Returns an array of lines output from a program.  Use this only if you
# expect that the output will be short.
#
# Since there is no way to disambiguate no output from an error, this
# function will call die on error, wrap in eval if this bugs you.
#
# First parameter is the program to run, all remaining arguments are
# passed to the program.
sub slurp_program_output
{
    my ($program, @args) = @_;
    my $output;

    debug "Slurping '$program' '", join("' '", @args), "'";
    my $pid = open3(0, $output, undef, $program, @args);

    # Just read all the input in so we can safely waitpid the process
    my @lines = <$output>;

    close $output;
    waitpid $pid, 0;

    return @lines;
}

# A simple wrapper that is used to split the output of 'git config --null'
# correctly. All parameters are then passed to slurp_program_output (so look
# there for help on usage).
sub slurp_git_config_output
{
    local $/ = "\000"; # Split on null

    # This gets rid of the trailing nulls for single-line output. (chomp uses
    # $/ instead of hardcoding newline
    chomp(my @output = slurp_program_output(@_));
    return @output;
}

# Returns a requested parameter from 'svn info' for the given module.
#
# First parameter is the module.
# Second parameter is a string with the name of the parameter to retrieve (i.e. URL).
#   Each line of output from svn info is searched for the requested string.
# Returns the string value of the parameter or undef if an error occurred.
sub get_svn_info
{
    my $module = shift;
    my $param = shift;
    my $srcdir = get_fullpath($module, 'source');
    my $result; # Predeclare to outscope upcoming eval

    # Search each line of output, ignore stderr.
    # eval since IPC::Open3 uses exceptions.
    eval
    {
        # Need to chdir into the srcdir, in case srcdir is a symlink. svn info /path/to/symlink barfs.
        p_chdir ($srcdir);
        my $output;
        local $ENV{'LC_ALL'} = 'C'; # Make the svn output untranslated
        my @lines = slurp_program_output('svn', 'info', '--non-interactive', '.');

        foreach (@lines)
        {
            ($result) = m/^$param:\s*(.*)$/;

            if ($result)
            {
                chomp $result;
                last;
            }
        }
    };

    if($@)
    {
        error "Unable to run r[b[svn], is the Subversion program installed?";
        error " -- Error was: r[$@]";
        return undef;
    }

    return $result;
}

# Returns a string containing the current on-disk revision number of the
# given Subversion repository, or undef if there was an error.
#
# First parameter is the name of the module to examine.
sub current_module_revision
{
    my $module = shift;

    return get_svn_info($module, 'Revision');
}

# Subroutine to recursively deep copy (from a completely independent clone)
# of the modules given for module A (first parameter) to module B (second
# parameter).
#
# If options are already set for B, the function returns immediately to
# avoid overwriting already set options.
#
# No return value.
sub clone_options
{
    my ($a, $b) = @_;

    return if exists $package_opts{$b};

    $package_opts{$b} = { 'set-env' => { } };

    # set-env is special because it itself holds another reference.  All the
    # others can be copies.
    for my $key (keys %{$package_opts{$a}})
    {
        next if $key eq 'set-env';
        $package_opts{$b}{$key} = $package_opts{$a}{$key};
    }

    # Handle set-env options.
    for my $key (keys %{$package_opts{$a}{'set-env'}})
    {
        $package_opts{$b}{'set-env'}{$key} = $package_opts{$a}{'set-env'}{$key};
    }
}

# 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 = "kdesrc-build $versionNum";
    my $author = <<DONE;
$version was written (mostly) by:
  Michael Pyne <mpyne\@kde.org>

Many people have contributed code, bugfixes, and documentation.

Please report bugs using the KDE Bugzilla, at http://bugs.kde.org/
DONE

    my @argv;
    my @saved_opts = @ARGV; # Save options for debugging purposes.

    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
the latest source code).

It is recommended that you first setup a .kdesrc-buildrc file in your home
directory.  Please visit http://kdesrc-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 .kdesrc-buildrc,
a default set of options will be used, which a few modules to be built by
default.

After setting up .kdesrc-buildrc, you can run this program from either the
command-line or from cron.  It will automatically download the modules from the
source repository, 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 kdesrc-build will
try by default to install the modules.

Basic synopsis, after setting up .kdesrc-buildrc:
\$ kdesrc-build [module names] (Download, build, and install KDE)

If you don\'t specify any particular module names, then your settings
in .kdesrc-buildrc will be used.  If you DO specify a module name, then
your settings will still be read, but the script will try to build/install
the modules in the order given on the command line.

Copyright (c) 2003 - 2009 $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 source server.
    --no-src
    --no-build           Skip the build process.
    --no-install         Don't automatically install after build.
    --purge-old-logs     Remove old log files after build.

    --svn-only           Only update the source code (Identical to --no-build
                         at this point).
    --src-only
    --build-only         Build only, don't perform updates or install.

    --pretend (or -p)    Don't actually contact the source 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 kdesrc-build is
                         performing.
    --really-quiet       Only warnings and errors will be displayed.
    --verbose (or -v)    Be *very* descriptive of the build process.  Only
                         --debug outputs more.
    --debug              Activates debug mode.
    --color
    --no-color           Add (or remove) color from the output.

    --rc-file=<filename> Read configuration from filename instead of default.
    --nice=<value>       Allows you to run the script with a lower priority
                         The default value is 10 (lower priority by 10 steps).
    --prefix=/kde/path   This option is a shortcut to change the setting for
                         kdedir from the command line.  It implies
                         --reconfigure.

    --resume-from=<pkg>  Starts building from the given package, without
                         performing the source update.
    --resume-after=<pkg> Starts building after the given package, without
                         performing the source update.
    --revision (or -r)=<rev> Forces update to revision <rev> from Subversion.

    --refresh-build      Start the build from scratch.
    --reconfigure        Run CMake/configure again, but don't clean the build
                         directory.
    --build-system-only  Create the build infrastructure, but don't actually
                         perform the build.
    --run=<program>      Runs the given program in the same environment
                         kdesrc-build runs in.
    --install            Try to install the packages passed on the command
                         line, or all packages in ~/.kdesrc-buildrc that don't
                         have manual-build set.  Building and source
                         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 going online to http://kdesrc-build.kde.org/ to view
the online documentation.  The documentation is installed with the kdesdk
module, so you may be able to view the documentation using KHelpCenter or
Konqueror at help:/kdesrc-build
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 {
                $run_mode = 'install';
                last SWITCH;
            };

            /^--uninstall$/ && do {
                $run_mode = 'uninstall';
                last SWITCH;
            };

            # Option exists for debugging.  This disables downloading of
            # snapshots from kdesrc-build.kde.org (kdesrc-build won't even
            # check if it's possible).
            /^--no-snapshots$/ && do {
                set_option('global', '#disable-snapshot', 1);
                last SWITCH;
            };

            /^--no-(src|svn)$/ && do {
                set_option('global', '#no-svn', 1);
                last SWITCH;
            };

            /^--no-install$/ && do {
                set_option('global', '#install-after-build', 0);
                last SWITCH;
            };

            /^--(force-build)|(no-build-when-unchanged)$/ && do {
                set_option('global', '#build-when-unchanged', 1);
                last SWITCH;
            };

            /^--purge-old-logs=?/ && do {
                set_option('global', '#purge-old-logs', 1);
                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);
                debug "Commandline was: ", join(', ', @saved_opts);
                last SWITCH;
            };

            /^--reconfigure$/ && do {
                set_option('global', '#reconfigure', 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;
            };

            /^--async$/ && do {
                set_option('global', '#async', 1);
                last SWITCH;
            };

            /^--no-async$/ && do {
                set_option('global', '#async', 0);
                last SWITCH;
            };

            # Although equivalent to --no-build at this point, someday the
            # script may interpret the two differently, so get ready now.
            /^--(src|svn)-only$/ && do {      # Identically to --no-build
                set_option('global', '#manual-build', 1);
                last SWITCH;
            };

            # Don't run source updates or install
            /^--build-only$/ && do {
                set_option('global', '#no-svn', 1);
                set_option('global', '#install-after-build', 0);
                last SWITCH;
            };

            # Start up a program with the environment variables as
            # read from the config file.
            /^--run=?/ && do {
                my $program = extract_option_value_required($_, @ARGV);
                set_option('global', '#start-program', $program);

                # Save remaining command line options to pass to the program.
                return;
            };

            /^--build-system-only$/ && do {
                set_option('global', '#build-system-only', 1);
                last SWITCH;
            };

            /^--rc-file=?/ && do {
                my $rcfile = extract_option_value_required($_, @ARGV);
                @rcfiles = ( $rcfile );

                last SWITCH;
            };

            /^--prefix=?/ && do {
                my $prefix = extract_option_value_required($_, @ARGV);

                set_option('global', '#kdedir', $prefix);
                set_option('global', '#reconfigure', 1);

                last SWITCH;
            };

            /^--nice=?/ && do {
                my $niceness = extract_option_value_required($_, @ARGV);

                set_option('global', '#niceness', $niceness);
                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);
                # Simulate the build process too.
                set_option('global', '#build-when-unchanged', 1);
                last SWITCH;
            };

            /^--refresh-build$/ && do {
                set_option('global', '#refresh-build', 1);
                last SWITCH;
            };

            /^(--revision|-r)=?/ && do {
                my $revision = extract_option_value_required($_, @ARGV);
                set_option('global', '#revision', $revision);

                last SWITCH;
            };

            /^--resume-from=?/ && do {
                $_ = extract_option_value_required($_, @ARGV);
                set_option('global', '#resume-from', $_);
                set_option('global', '#no-svn', 1);

                last SWITCH;
            };

            /^--resume-after=?/ && do {
                $_ = extract_option_value_required($_, @ARGV);
                set_option('global', '#resume-after', $_);
                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;
                    }

                    # TODO: In pathological situations this may cause an
                    # inaccurate collection of options for this module due to
                    # the default options not being set correctly.
                    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;

    # Don't go async if only performing one phase.  It (should) work but why
    # risk it?
    if(get_option('global', 'manual-build') or get_option('global', 'no-svn'))
    {
        set_option('global', '#async', 0);
    }
}

# Installs the given subroutine as a signal handler for a set of signals which
# could kill the program.
#
# First parameter is a reference to the sub to act as the handler.
sub install_signal_handler
{
    my $handler = shift;
    my @signals = qw/HUP INT QUIT ABRT TERM PIPE/;

    @SIG{@signals} = ($handler) x scalar @signals;
}

# Subroutine to try to get a lock on the script's lockfile to prevent
# more than one script from updating KDE 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}/.kdesrc-lock";
    $! = 0; # Force reset to non-error status
    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.
    install_signal_handler(\&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 kdesrc-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 kdesrc-build.  Don't use error,
                # it'll scan for $!
                print clr " r[*y[*r[*] kdesrc-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[*] kdesrc-build run canceled.\n";
                    exit 1;
                }

                # We still can't grab the lockfile, let's just hope things
                # work out.
                print clr " y[*] kdesrc-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 kdesrc-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.
    }
    elsif ($errorCode == ENOTTY)
    {
        # Stupid bugs... normally sysopen will return ENOTTY, not sure who's to blame between
        # glibc and Perl but I know that setting PERLIO=:stdio in the environment "fixes" things.
        ; # pass
    }
    elsif ($errorCode != 0) # Some other error occurred.
    {
        warning " r[*]: Error $errorCode while creating lock file (is home directory available?)";
        warning " r[*]: Continuing the script for now...";

        # 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 kdesrc-build to build KDE.
        return 1;
    }

    print LOCKFILE "$$\n";
    close LOCKFILE;

    return 1;
}

# Subroutine to free the lock allocated by get_lock()
sub close_lock
{
    my $lockfile = "$ENV{HOME}/.kdesrc-lock";

    close LOCKFILE;
    unlink $lockfile;
}

# Subroutine to get the list of KDE modules to update.  Returned
# as a list.  Parse the command-line arguments first.
sub get_update_list
{
    return @ARGV unless $#ARGV == -1;

    # l10n module has different names for KDE 3 and KDE 4.
    my $l10n = 'l10n-kde4';

    if (get_option('global', 'kde-languages') and not get_option($l10n, 'manual-update'))
    {
        push @update_list, $l10n; # Add l10n module to potential update list.
    }

    return grep {
        not get_option($_, 'manual-update')
    } (@update_list);
}

# Subroutine to get the list of KDE 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-from and --resume-after options.
sub get_build_list
{
    my $resume_point = get_option('global', '#resume-from');
    my $resume_point_after = get_option('global', '#resume-after');

    # Set resume_point.
    if ($resume_point_after)
    {
        if ($resume_point)
        {
            # Whoops, can't enable both
            error <<EOF;
You specified both r[b[--resume-from] and r[b[--resume-after] but you can only
use one.
EOF

            die make_exception('Runtime',
                "Both --resume-after and --resume-from specified.");
        }

        $resume_point = $resume_point_after;
    }

    # l10n module has different names for KDE 3 and KDE 4.
    my $l10n = 'l10n-kde4';

    # Add l10n to build list if needed.
    if (get_option('global', 'kde-languages') and not get_option($l10n, 'manual-build'))
    {
        push @build_list, $l10n;
    }

    # We check explicitly for sticky options here since they can only be
    # set from the command line.
    if (get_option('global', '#manual-build'))
    {
        if ($resume_point)
        {
            my $option = '--resume-from';
            $option = '--resume-after' if get_option('global', '#resume-after');

            warning "I'm confused, you enabled y[--no-build] and y[$option].";
            warning "Skipping the build process.";
        }

        return ();
    }

    if ($resume_point)
    {
        # Pop stuff off of the list until we hit the resume point.
        while (scalar @build_list > 0)
        {
            last if $build_list[0] eq $resume_point;
            shift @build_list;
        }

        # One further for the --resume-after case.
        if ($resume_point_after)
        {
            shift @build_list;
        }

        if (not @build_list)
        {
            warning "Can't resume from y[$resume_point], it wasn't going to be built!";
        }

        return @build_list;
    }

    return @ARGV unless $#ARGV == -1;

    return grep {
        not get_option($_, 'manual-update') and
        not get_option($_, 'manual-build')
    } (@build_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 %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 rename the given file if global-pretend isn't set.
sub safe_rename($$)
{
    my ($from, $to) = @_;

    if (pretending)
    {
        pretend "\tWould have renamed '$from' to '$to'.";
        return 1; # Return true
    }

    return rename($from, $to);
}

# 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.
#
# Returns the shell error code, so 0 means success, non-zero means failure.
sub safe_system(@)
{
    if (not pretending)
    {
        whisper "\tExecuting g[", join(" ", @_);
        return system (@_) >> 8;
    }

    pretend "\tWould have run g[", join(' ', @_);
    return 0; # Return true
}

# Is exactly like "chdir", but it will also print out a message saying that
# we're switching to the directory when debugging.
sub p_chdir($)
{
    my $dir = shift;
    debug "\tcd g[$dir]\n";
    chdir $dir;
}

# 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;

        # Check again if the directory does not exist before failing, since this
        # function may be run concurrently in different processes.
        return 0 if not mkdir ($temp) and not -e $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.
#
# First parameter is the module that did not build.
# Second parameter is the IPC connection to send the required message over
# Third parameter is the error reason (e.g. IPC::MODULE_CONFLICT).
# No return value;
sub dont_build
{
    my $module = shift;
    my $ipc = shift;
    my $reason = shift;

    whisper "Not building $module";

    if ($ipc)
    {
        $ipc->sendIPCMessage($reason, $module);
    }
    else
    {
        # Weed out matches of the module name
        @build_list = grep (!/^$module$/, @build_list);

        if (get_option($module, '#conflict-found'))
        {
            # Record now for posterity
            set_persistent_option($module, "conflicts-present", 1);
        }
    }

    if ($reason != IPC::MODULE_UPTODATE)
    {
        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
{
    # Don't bother with all this if the user isn't even using SSH.
    return 1 if pretending;

    my @svnServers = grep {
        module_scm_type($_) eq 'svn';
    } (@update_list);

    my @gitServers = grep {
        module_scm_type($_) eq 'git';
    } (@update_list);

    my @sshServers = grep {
        my ($proto, $host) = split_url(get_option($_, 'svn-server'));

        # Check if ssh is explicitly used in the proto, or if the host is the
        # developer main svn.
        (defined $proto && $proto =~ /ssh/) || (defined $host && $host =~ /^svn\.kde\.org/);
    } @svnServers;

    push @sshServers, grep {
        # Check for git+ssh:// or git@git.kde.org:/path/etc.
        my $repo = get_option($_, 'repository');
        ($repo =~ /^git\+ssh:\/\//) || ($repo =~ /^[a-zA-Z0-9_.]+@.*:\//);
    } @gitServers;

    whisper "\tChecking for SSH Agent" if (scalar @sshServers);
    return 1 if (not @sshServers) 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 (this check is linux-specific at the moment).
    if (-d "/proc" and 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 kdesrc-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 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.
#
# The $ipc variable contains an object that is responsible for communicating
# the status of building the modules.  This function must account for every
# module in @update_list to $ipc before returning.
#
# Returns 0 on success, non-zero on error.
sub handle_updates
{
    my $ipc = shift;
    my $kdesrc = get_source_dir();
    my $hadError = 0;

    # No reason to print out the text if we're not doing anything.
    if (scalar @update_list == 0)
    {
        $ipc->sendIPCMessage(IPC::ALL_UPDATING, "update-list-empty");
        return 0;
    }

    if (get_option ('global', 'no-svn'))
    {
        $ipc->sendIPCMessage(IPC::ALL_SKIPPED, "no-svn");
        return 0;
    }

    if (not check_for_ssh_agent())
    {
        $ipc->sendIPCMessage(IPC::ALL_FAILURE, "ssh-failure");
        return 1;
    }

    # Be much quieter if operating multiprocess and the user has not chosen a
    # different mode.
    if ($ipc->supportsConcurrency() and not get_option('global', '#debug-level'))
    {
        set_option('global', '#debug-level', WARNING);
    }

    note "<<<  Updating Source Directories  >>>";
    info " "; # Add newline for aesthetics unless in quiet mode.

    if (not -e $kdesrc)
    {
        whisper "KDE source download directory doesn't exist, creating.\n";
        if (not super_mkdir ($kdesrc))
        {
            error "Unable to make directory r[$kdesrc]!";
            $ipc->sendIPCMessage(IPC::ALL_FAILURE, "no-source-dir");

            return 1;
        }
    }

    # Once at this point, any errors we get should be limited to a module,
    # which means we can tell the build thread to start.
    $ipc->sendIPCMessage(IPC::ALL_UPDATING, "starting-updates");

    # Make sure KDE's SSL signature is present since --non-interactive is
    # passed to svn.
    if (grep { module_scm_type($_) eq 'svn' } @update_list) {
        install_missing_ssl_signature();
    }

    # Calculate l10n module name. The logic is duplicated on purpose with
    # filter_l10n_module_list because we have to handle the $l10n/scripts
    # directory specially (just on update).
    my $l10n = 'l10n-kde4';

    foreach my $module (@update_list)
    {
        $module = $l10n if $module eq 'l10n'; # Correct internal name.

        check_for_module_config ($module);

        my $module_src_dir = get_source_dir($module);
        if ($kdesrc ne $module_src_dir)
        {
            # This module has a different source directory, ensure it exists.
            if (not super_mkdir($module_src_dir))
            {
                error "Unable to create separate source directory for r[$module]";
                $ipc->sendIPCMessage(IPC::MODULE_FAILURE, $module);
                next;
            }
        }

        if(get_option($module, 'no-svn'))
        {
            $ipc->sendIPCMessage(IPC::MODULE_SKIPPED, $module);
            next;
        }

        my @options = split(' ', get_option($module, 'checkout-only'));

        # Use kde-langauges option if this isn't set on command line.
        if ($module eq $l10n and not scalar @options)
        {
            push @options, split(' ', get_option('global', 'kde-languages'));
        }

        # Make sure each submodule of l10n has their own options hash.
        if ($module eq $l10n)
        {
            # Ensure that scripts is pulled in for the update process (not req'd
            # for build or install)
            push @options, 'scripts';

            for my $lang (@options)
            {
                clone_options($l10n, "$l10n/$lang");
            }
        }

        my $fullpath = get_fullpath($module, 'source');
        my $count;

        eval {
            if (module_scm_type($module) eq 'git') {
                # Handle git module update
                $count = update_module_git_checkout($module);
            }
            elsif (-e "$fullpath/.svn")
            {
                # Warn user if the current repo URL is different than expected.
                check_module_validity($module);
                $count = update_module_path($module, @options);
            }
            else
            {
                $count = checkout_module_path($module, @options);
            }
        };

        if ($@)
        {
            error "Error updating r[$module], removing from list of packages to build.";
            error " > y[$@]";

            my $reason = get_option($module, '#update-error');
            $reason = IPC::MODULE_FAILURE unless $reason; # Default error code
            dont_build ($module, $ipc, $reason); # Sends IPC message.
            $hadError = 1;
        }
        else
        {
            my $message;
            if (not defined $count)
            {
                $message = clr "b[y[Unknown changes]." if not defined $count;
                $ipc->notifyUpdateSuccess($module, $message);
            }
            elsif ($count)
            {
                $message = "1 file affected." if $count == 1;
                $message = "$count files affected." if $count != 1;
                $ipc->notifyUpdateSuccess($module, $message);
            }
            else
            {
                whisper "This module will not be built. Nothing updated.";
                dont_build($module, $ipc, IPC::MODULE_UPTODATE); # Sends IPC message.
            }
        }

        info ""; # Print empty line.
    }

    info "<<<  Update Complete  >>>\n";
    return $hadError;
}

# Returns a hash digest of the given options in the list.  The return value is
# base64-encoded at this time.
#
# Note: Don't be dumb and pass data that depends on execution state as the
# returned hash is almost certainly not useful for whatever you're doing with
# it.  (i.e. passing a reference to a list is not helpful, pass the list itself)
#
# Parameters: List of scalar values to hash.
# Return value: base64-encoded hash value.
sub get_list_digest
{
    use Digest::MD5 "md5_base64"; # Included standard with Perl 5.8

    return md5_base64(@_);
}

# 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 $srcdir = get_fullpath($module, 'source');
    my $script = "$srcdir/configure";

    my @commands = split (/\s+/, get_option($module, 'configure-flags'));
    push @commands, '-confirm-license', '-opensource';

    # Get the user's CXXFLAGS
    my $cxxflags = get_option ($module, 'cxxflags');
    setenv ('CXXFLAGS', $cxxflags);
    setenv ('DO_NOT_COMPILE', get_option ($module, 'do-not-compile'));

    # This is only run for qt-copy, so let's verify that.
    if ($module ne 'qt-copy') {
        error <<EOF;
r[b[ *] kdesrc-build assumes that only Qt would be compiled using a configure
r[b[ *] script, but we're trying to configure r[b[$module].  Please report a
r[b[ *] bug at http://bugs.kde.org/ -- Unable to build this module.
EOF
        return 1;
    }

    my $prefix = get_option($module, 'qtdir');

    # Some users have added -prefix manually to their flags, they
    # probably shouldn't anymore. :)

    if (scalar grep /^-prefix(=.*)?$/, @commands)
    {
        warning <<EOF;
b[y[*]
b[y[*] You have the y[-prefix] option selected in your qt-copy configure flags.
b[y[*] kdesrc-build will correctly add the -prefix option to match your Qt
b[y[*] directory setting, so you do not need to use -prefix yourself.
b[y[*]
EOF
    }

    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";
    }

    # We use a special script for qt-copy to auto-accept the license, it is created
    # just before running it (see below).
    my $qtdir = get_fullpath('qt-copy', 'source');
    my $builddir = get_fullpath($module, 'build');

    $script = "$qtdir/configure" if $module eq 'qt-copy';
    unshift @commands, $script;

    my $old_flags = get_persistent_option($module, 'last-configure-flags') || '';

    if((get_list_digest(@commands) ne $old_flags) or
       (get_option($module, 'reconfigure')) or
       (not -e "$builddir/Makefile")
      )
    {
        note "\tb[r[LGPL license selected for Qt].  See $srcdir/LICENSE.LGPL";

        info "\tRunning g[configure]...";

        set_persistent_option($module, 'last-configure-flags', get_list_digest(@commands));
        return log_command($module, "configure", \@commands);
    }

    # Skip execution of configure.
    return 0;
}

# Subroutine to run CMake to create the build directory for a module.
# CMake is not actually run if pretend mode is enabled.
#
# First parameter is the module to run cmake on.
# Return value is the shell return value as returned by log_command().  i.e.
# 0 for success, non-zero for failure.
sub safe_run_cmake
{
    my $module = shift;
    my $srcdir = get_fullpath($module, 'source');
    my @commands = split_quoted_on_whitespace (get_option($module, 'cmake-options'));

    # grep out empty fields
    @commands = grep {!/^\s*$/} @commands;

    # Add -DBUILD_foo=OFF options for the directories in do-not-compile.
    # This will only work if the CMakeLists.txt file uses macro_optional_add_subdirectory()
    my @masked_directories = split(' ', get_option($module, 'do-not-compile'));
    push @commands, "-DBUILD_$_=OFF" foreach @masked_directories;

    # Get the user's CXXFLAGS, use them if specified and not already given
    # on the command line.
    my $cxxflags = get_option ($module, 'cxxflags');
    if ($cxxflags and not grep { /^-DCMAKE_CXX_FLAGS(:\w+)?=/ } @commands)
    {
        push @commands, "-DCMAKE_CXX_FLAGS:STRING=$cxxflags";
    }

    my $prefix = get_option ($module, 'prefix');

    # If still no prefix, use KDEDIR
    $prefix = get_option($module, 'kdedir') unless $prefix;

    push @commands, "-DCMAKE_INSTALL_PREFIX=$prefix";

    if (get_option($module, 'run-tests') and
        not grep { /^\s*-DKDE4_BUILD_TESTS(:BOOL)?=(ON|TRUE|1)\s*$/ } (@commands)
       )
    {
        whisper "Enabling tests";
        push @commands, "-DKDE4_BUILD_TESTS:BOOL=ON";

        # Also enable phonon tests.
        if ($module =~ /^phonon$/) {
            push @commands, "-DPHONON_BUILD_TESTS:BOOL=ON";
        }
    }
    if (get_option($module, 'run-tests') eq 'upload')
    {
        whisper "Enabling upload of test results";
        push @commands, "-DBUILD_experimental:BOOL=ON";
    }


    # For l10n-kde4, we must run cmake to search in the (fake) build dir.  There
    # is no srcdir != builddir (but we do simulate it).
    if ($module =~ /^l10n-kde4\/?/)
    {
        $srcdir = ".";
    }

    unshift @commands, 'cmake', $srcdir; # Add to beginning of list.

    my $old_options = get_persistent_option($module, 'last-cmake-options') || '';
    my $builddir = get_fullpath($module, 'build');

    if (($old_options ne get_list_digest(@commands)) or
        get_option($module, 'reconfigure') or
        not -e "$builddir/CMakeCache.txt" # File should exist only on successful cmake run
       )
    {
        info "\tRunning g[cmake]...";

        # Remove any stray CMakeCache.txt
        safe_unlink "$srcdir/CMakeCache.txt"   if -e "$srcdir/CMakeCache.txt";
        safe_unlink "$builddir/CMakeCache.txt" if -e "$builddir/CMakeCache.txt";

        set_persistent_option($module, 'last-cmake-options', get_list_digest(@commands));
        return log_command($module, "cmake", \@commands);
    }

    # Skip cmake run
    return 0;
}

# Subroutine to try and see if we've already tried to update kde-common
sub has_updated_kdecommon
{
    # Double check that it wasn't in the update list.
    return (grep(/^(KDE\/)?kde-common$/, @update_list)) ? 1 : 0;
}

# 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";
        if (not pretending and not super_mkdir($to))
        {
            error "Couldn't create directory r[$to]: b[r[$!]";
            return 0;
        }
    }

    # 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)
            {
                super_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 ($@)
    {
        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 kdesrc-build does *NOT*
    # fork another kdesrc-build using exec, see sub log_command() for more
    # info.
    my $args = [ 'kdesrc-build', 'safe_lndir', $srcdir, $builddir ];

    # Skip modules that don't need special treatment.
    return 1 unless module_needs_builddir_help($module);

    # 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 any preparatory steps (like for
# l10n modules).  This subroutine assumes that the module is already
# downloaded.
sub safe_create_build_system
{
    my $module = shift;
    my $srcdir = get_fullpath($module, 'source');
    my $builddir = get_fullpath($module, 'build');
    my $uses_cmake = module_uses_cmake($module);

    whisper "\tCMake support for $module: ", $uses_cmake ? "Yes" : "No";

    if (pretending)
    {
        pretend "\tWould have created g[$module]\'s build system.";
        return 0;
    }

    # KDE 4 l10n modules use CMake but require extra preparation
    # before they can be built, so don't abort out for that module.
    if ($uses_cmake)
    {
        return 0 unless $module =~ /^l10n-kde4\/?/; # Done.
    }

    # Setup in the build directory.
    p_chdir ($builddir);

    # Verify we're building what we expect.
    if ($module !~ /^l10n-kde4\//) {
        error " r[b[*] kdesrc-build only expects to need to create a build system for l10n";
        error " r[b[*] modules, but was asked to do so for r[b[$module] -- aborting.";
        return 1;
    }

    my ($lang) = ($module =~ /^l10n-kde4\/(.*)$/);
    my $cmd_ref = [ './scripts/autogen.sh', $lang ];

    # autogen.sh must be run from one level below for some reason.
    p_chdir ("../");

    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

    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.
#
# This function will throw an exception in the event of a build failure.
#
# 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.
# Return value is the number of files update (may be undef if unable to tell)
sub run_svn
{
    my ($module, $logfilename, $arg_ref) = @_;
    my $conflict = 0;

    my $revision = get_option($module, '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.
    my $result = log_command($module, $logfilename, $arg_ref);

    return 0 if pretending;

    # Exception handling. Scary!
    die "Error updating $module: $!" unless $result == 0;

    my $logdir = get_log_dir($module);
    $logfilename = "$logdir/$logfilename.log";

    # We need to open the file and try to determine what the Subversion process
    # did.
    open SVN_LOG, "<$logfilename" or return undef;

    my $count = 0;
    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 all changes to the files.
        $count++ if /^[UPDARGMC][ A-Z]/;

        $conflict = 1 if /^C[ A-Z]/;
    }

    close SVN_LOG;

    if ($conflict)
    {
        warning "Source code conflict exists in r[$module], this module will not";
        warning "build until it is resolved.";

        # If in async this only affects the update process, we need to IPC it
        # to the build process.
        set_option($module, '#update-error', IPC::MODULE_CONFLICT);
        die "Source conflicts exist in $module";
    }

    return $count;
}

# Subroutine to delete recursively, everything under the given directory,
# unless we're in pretend mode.
#
# i.e. the effect is similar to "rm -r $arg/* $arg/.*".
#
# This assumes we're called from a separate child process.  Therefore the
# normal logging routines are /not used/, since our output will be logged
# by the parent kdesrc-build.
#
# The first parameter should be the absolute path to the directory to delete.
#
# Returns boolean true on success, boolean false on failure.
sub prune_under_directory
{
    my $dir = shift;

    print "starting delete of $dir\n";

    # This closure subroutine will be called for every file/directory.
    # It will be called in a postorder traversal (i.e. parent processed after
    # all the children).
    my $wanted = sub {
        my $name = $File::Find::name;

        # Don't delete the parent directory, just everything under.
        return if ($name eq $dir);

        lstat ($name); # stats the actual symlink.  Called now for caching.

        if (not -l _ and -d _)
        {
            # Remove directory.
            debug "Removing directory $name";
            if (not pretending)
            {
                rmdir ($name) or die "Couldn't delete $name!: $!";
            }
        }
        else
        {
            # Remove file/symlink/etc.
            debug "Removing file $name";
            if (not pretending)
            {
                unlink ($name) or die "Couldn't delete $name!: $!";
            }
        }
    };

    # Call recursive find.
    eval {
        finddepth ($wanted, $dir);
    };

    if ($@)
    {
        error "\tUnable to clean r[$dir]:\n\ty[b[$@]";
        return 0;
    }

    return 1;
}

# 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;
    }

    # Use an existing directory
    if (-e "$builddir" && "$builddir" ne "$moduledir")
    {
        info "\tRemoving files in build directory for g[$module]";

        # This variant of log_command runs the sub prune_under_directory($builddir)
        # in a forked child, so that we can log its output.
        if (log_command($module, 'clean-builddir', [ 'kdesrc-build', 'prune_under_directory', $builddir ]))
        {
            error " r[b[*]\tFailed to clean build directory.  Verify the permissions are correct.";
            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's my HD so active?...
        info "\tOld build system cleaned, starting new build system.";
    }
    # or create the directory
    elsif (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 $srcdir = get_fullpath($module, 'source');
    my $builddir = get_fullpath($module, 'build');
    my $uses_cmake = module_uses_cmake($module);

    # As a special case to the normal instances where we will rebuild a module,
    # also force a rebuild if we're using CMake but the current build directory
    # is unsermake-based.  libtool is only used by autotools/unsermake.
    if (needs_refreshed($module) or ($uses_cmake and -e "$builddir/libtool"))
    {
        # 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].";

        if ($uses_cmake and -e "$builddir/libtool")
        {
            info "\t\ty[Rebuild forced] due to switch of build system to CMake.";
        }

        # 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;
        }
    }

    # Symlink source directory to build directory if module doesn't support
    # srcdir != builddir.
    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;
        }
    }

    my $confpath = module_needs_builddir_help($module) ? $builddir : $srcdir;

    # The l10n-kde4 module requires some initial build system setup unlike
    # every other CMake module.  We can tell if it has been setup because then
    # its builddir will have a CMakeLists.txt
    if ($module =~ /^l10n-kde4\/?/)
    {
        if (safe_create_build_system ($module))
        {
            error "\tUnable to create configure system from checkout.";
            return 0;
        }

        set_option($module, '#reconfigure', 1); # Force reconfigure of the module
    }

    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
    p_chdir ($builddir);

    # Appropriate configure function will skip automatically if configuration is
    # unnecessary.  (re)configuration is always done if the 'reconfigure' option is true.
    if (not $uses_cmake)
    {
        # configure the module (sh script return value semantics)
        if (safe_configure ($module))
        {
            error "\tUnable to configure r[$module]!";
            return 0;
        }
    }
    else
    {
        # Use cmake to create the build directory (sh script return value
        # semantics).
        if (safe_run_cmake ($module))
        {
            error "\tUnable to configure r[$module] with CMake!";
            return 0;
        }
    }

    return 1;
}

# Adds the given library paths to the path already given in an environment
# variable. In addition, detected "system paths" are stripped to ensure that
# we don't inadvertently re-add a system path to be promoted over the custom
# code we're compiling (for instance, when a system Qt is used and installed to
# /usr).
#
# First parameter is the name of the environment variable to modify
# All remaining paramters are prepended to the current environment path, in
#   the order given. (i.e. param1, param2, param3 -> param1:param2:param3:existing
sub prepend_environment_path
{
    my $envName = shift;
    my @curPaths = split(':', $ENV{$envName}) if defined $ENV{$envName};

    # Filter out entries to add that are already in the environment from the
    # system.
    for my $path (grep { list_has(@curPaths, $_) } (@_) ) {
        debug "\tNot prepending y[$path] to y[$envName] as it appears " .
              "to already be defined in y[$envName].";
    }

    @_ = grep { not list_has(@curPaths, $_); } (@_);

    my $envValue = join(':', @_, @curPaths);

    $envValue =~ s/^:*//;
    $envValue =~ s/:*$//; # Remove leading/trailing colons
    $envValue =~ s/:+/:/; # Remove duplicate colons

    setenv($envName, $envValue);
}

# Subroutine to setup the environment for a module.  First parameter is the name of
# the module to set the environment for
sub update_module_environment
{
    my $module = shift;
    my $kdedir = get_option ($module, 'kdedir');
    my $qtdir = get_option ($module, 'qtdir');
    my $prefix = get_option ($module, 'prefix');

    $prefix = $kdedir unless $prefix;

    # Add global set-envs
    setup_module_environment ('global');

    # Add some standard directories for pkg-config support.  Include env settings.
    my @pkg_config_dirs = ("$kdedir/lib/pkgconfig", "$qtdir/lib/pkgconfig");
    prepend_environment_path('PKG_CONFIG_PATH', @pkg_config_dirs);

    # Likewise, add standard directories that should be in LD_LIBRARY_PATH.
    my @ld_dirs = ("$kdedir/lib", "$qtdir/lib", get_option($module, 'libpath'));
    prepend_environment_path('LD_LIBRARY_PATH', @ld_dirs);

    my @path = ("$kdedir/bin", "$qtdir/bin", get_option ($module, 'binpath'));

    if (module_uses_cmake($module))
    {
        prepend_environment_path('CMAKE_PREFIX_PATH', $prefix);
    }

    prepend_environment_path('PATH', @path);

    # Set up the children's environment.  We use setenv since it
    # won't set an environment variable to nothing.  (e.g, setting
    # QTDIR to a blank string might confuse Qt or KDE.

    setenv ('QTDIR', $qtdir);

    # If the module isn't kdelibs, also append kdelibs's KDEDIR setting.
    if ($module ne 'kdelibs')
    {
        my $kdelibsDir = get_option('kdelibs', 'kdedir');
        if ($kdelibsDir and $kdelibsDir ne $kdedir) {
            whisper "Module $module uses different KDEDIR than kdelibs, including kdelibs as well.";
            $kdedir .= ":$kdelibsDir"
        }
    }

    setenv ('KDEDIRS', $kdedir);

    # Read in user environment defines
    setup_module_environment ($module) unless $module eq 'global';
}

# 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 check for subversion conflicts in a module.  Basically just
# runs svn st and looks for "^C".
#
# First parameter is the module to check for conflicts on.
# Returns 0 if a conflict exists, non-zero otherwise.
sub module_has_conflict
{
    my $module = shift;

    my $srcdir = get_fullpath($module, 'source');

    if (get_option($module, 'no-svn'))
    {
        whisper "\tSource code conflict check skipped.";
        return 1;
    }
    else
    {
        info "\tChecking for source conflicts... ";
    }

    my $pid = open SVN, "-|";
    if (not defined $pid)
    {
        error "\tUnable to open check source conflict status: b[r[$!]";
        return 0; # false allows the build to proceed anyways.
    };

    if (0 == $pid)
    {
        close STDERR; # No broken pipe warnings
        exec (qw/svn --non-interactive st/, $srcdir) ||
            die "Cannot execute 'svn' program: $!";
        # Not reached
    }

    while (<SVN>)
    {
        if (/^C/)
        {
            error <<EOF;
The $module module has source code conflicts present.  This can occur
when you have made changes to the source code in the local copy
at $srcdir
that interfere with a change introduced in the source repository.
EOF

            error <<EOF if $module eq 'qt-copy';
This module can experience this problem due to the apply_patches script
sometimes.
EOF

            error <<EOF;
To fix this, y[if you have made no source changes that you haven't committed],
run y[svn revert -R $srcdir]
to bring the source directory back to a pristine state and trying building the
module again.

NOTE: Again, if you have uncommitted source code changes, running this command
will delete your changes in favor of the version in the source repository.
EOF

            kill "TERM", $pid; # Kill svn
            waitpid ($pid, 0);
            close SVN;
            return 0;
        }
    }

    # conflicts cleared apparently.
    waitpid ($pid, 0);
    close SVN;
    return 1;
}

# Subroutine to run the testsuite for a given module.
#
# First parameter is the module to run tests for.
# Returns true if all tests passed, false if some failed or there was an
#   error running tests.
sub run_tests
{
    my $module = shift;

    if (not module_uses_cmake($module)) {
        warning "Cannot run test suite for r[$module] as it does not use CMake";
        return 1; # But return true anyways
    }

    # Note that we do not run safe_make, which should really be called
    # safe_compile at this point.

    # Step 1: Ensure the tests are built, oh wait we already did that when we ran
    # CMake :)

    my $make_target = 'test';
    if (get_option($module, 'run-tests') eq 'upload') {
        $make_target = 'Experimental';
    }

    # Step 2: Run the tests.
    my $result = log_command($module, 'test-results', [ 'make', $make_target ]);
    if ($result != 0) {
        my $logdir = get_log_dir($module);
        my $logfile = "$logdir/test-results.log";
        my $numTests = -1;
        # Extract the number of failed tests
        if (open(my $logf, "<$logfile")) {
           my @lines = <$logf>;
           my @matches = grep (/failed out of/, @lines);
           if (scalar(@matches)) {
               ($numTests) = $matches[0] =~ /([0-9]+) tests failed out of/;
           }
        }
        if ($numTests > -1 ) {
           warning "\t$numTests tests failed for y[$module], consult $logdir/test-results.log for info";
        } else {
           warning "\tSome tests failed for y[$module], consult $logdir/test-results.log for info";
        }
        return 0;
    } else {
        info "\tAll tests ran successfully.";
    }

    return 1;
}

# 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 $builddir = get_fullpath($module, 'build');

    # Do some tests to make sure we're ready to build.
    check_for_module_config($module);

    update_module_environment($module);

    my $log_filter = sub {
        return unless defined $_;
        print $_ if /^C/;
        print $_ if /Checking for/;
        return;
    };

    # Use log_command as the check so that an error file gets created.
    if ((module_scm_type($module) eq 'svn') &&
        0 != log_command($module, 'conflict-check',
                         ['kdesrc-build', 'module_has_conflict', $module], $log_filter)
       )
    {
        return 0;
    }

    my $start_time = time;

    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))
    {
        # Build failed

        my $elapsed = prettify_seconds (time - $start_time);

        # Well we tried, but it isn't going to happen.
        note "\n\tUnable to build y[$module]!";
        info "\tTook g[$elapsed].";
        return 0;
    }
    else
    {
        my $elapsed = prettify_seconds (time - $start_time);
        info "\tBuild succeeded after g[$elapsed].";

        if (get_option($module, 'run-tests'))
        {
            run_tests($module); # Don't fail if this fails... yet
        }

        if (get_option($module, 'install-after-build'))
        {
            handle_install($module);
        }
        else
        {
            info "\tSkipping install for y[$module]";
        }
    }

    return 1;
}

# kdesrc-build supports putting the l10n module on the command line, but it is
# rather weird in that l10n isn't used as a module internally, instead the
# l10n/$lang are treated for the most part as modules.
#
# This function filters out any plain 'l10n' entries in the given module list,
# and adds the appropriate l10n/$lang modules to the end of the returned list.
#
# The languages are selected using l10n/checkout-only (preferred since it will
# be set from the command line), or using global/kde-languages (which should be
# used exclusively from the configuration file).
sub filter_l10n_module_list
{
    my @modules = @_;
    my $l10n = 'l10n-kde4';

    # Only filter if 'l10n' is actually present in list.
    my @matches = grep {$_ eq $l10n or $_ eq 'l10n'} @modules;
    my $subdirs;

    return @modules if not scalar @matches;

    for my $match (@matches)
    {
        @modules = grep {$_ ne $match} @modules; # Remove all instances of l10n

        # Grab first matching sub directory options, depending on if the user
        # used l10n or the full l10n-kde{3,4} module name on the command line.
        $subdirs = get_option($match, 'checkout-only') if not $subdirs;
    }

    # Still no subdirs?  Use kde-langauges.
    $subdirs = get_option('global', 'kde-languages') if not $subdirs;

    for my $dir (split (' ', $subdirs))
    {
        push @modules, "$l10n/$dir";

        # Give language its own options in %package_opts.
        clone_options($l10n, "$l10n/$dir");
    }

    # Make sure the /scripts directory is available in the build dir.
    prepare_fake_builddir("$l10n/scripts");

    return @modules;
}

# 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 $kdesrc 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 $ipc = shift;
    my @modules = grep (!/^(KDE\/)?kde-common$/, @build_list);
    my $result;

    # Handle l10n module, which is speshul.
    @modules = filter_l10n_module_list(@modules);

    # No reason to print building messages if we're not building.
    return 0 if scalar @modules == 0;

    note "<<<  Build Process  >>>";

    # Keeps track of svn status of the modules.
    my %svn_status = ();

    # IPC queue should have a message saying whether or not to bother with the
    # build.
    {
        my $buffer = "";
        my $ipcType = $ipc->receiveIPCMessage(\$buffer);

        if ($ipcType == IPC::ALL_FAILURE)
        {
            error " b[r[*] Unable to perform the source update (y[$buffer]), therefore";
            error " b[r[*] unable to build.";
            return 1;
        }
        elsif ($ipcType == IPC::ALL_SKIPPED)
        {
            $svn_status{$_} = 'all-skipped' foreach @update_list;
        }
        elsif ($ipcType != IPC::ALL_UPDATING)
        {
            error " b[r[***] IPC failure while expecting svn update status, wrong type: r[$ipcType]";
            return 1;
        }
    }

    my $outfile = undef;

    if (not pretending)
    {
        $outfile = get_output_file();
        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 (my $module = shift @modules)
    {
        note "Building g[$module] ($i/$num_modules)";
        resetenv(); # Resets the list of env vars to change
        my $start_time = time;

        # If using IPC, read in the contents of the message buffer, and wait
        # for completion of the svn update if necessary.

        if (not defined $svn_status{$module})
        {
            $svn_status{$module} = 0;
        }

        while(list_has(@update_list, $module) and not $svn_status{$module})
        {
            my $buffer;
            info "\tWaiting for source code update.";

            my $ipcType = $ipc->receiveIPCMessage(\$buffer);
            if (not defined $ipcType or not $ipcType)
            {
                error " b[r[***] $module: IPC failure during source update: r[b[$!]";
                return 1;
            }

            whisper "\tReceived IPC status message for $buffer: $ipcType";

            if($ipcType == IPC::MODULE_SUCCESS)
            {
                my ($module, $msg) = split(/,/, $buffer);
                $svn_status{$module} = 'success';

                note "\tSource update complete for g[$module]: $msg";
            }
            elsif($ipcType == IPC::MODULE_SKIPPED)
            {
                $svn_status{$buffer} = 'success';
                info "\tNo source update needed for g[$buffer]";
            }
            elsif($ipcType == IPC::MODULE_FAILURE or $ipcType == IPC::MODULE_CONFLICT)
            {
                $svn_status{$buffer} = 'failed';
                push @{$fail_lists{'update'}}, $buffer;
                error "\tUnable to update r[$buffer], build canceled.";

                # Increment failed count to track when to start bugging the
                # user to fix stuff.

                my $fail_count = get_persistent_option($buffer, 'failure-count');
                $fail_count = 0 unless defined $fail_count;
                ++$fail_count;
                set_persistent_option($buffer, 'failure-count', $fail_count);

                if ($ipcType == IPC::MODULE_CONFLICT)
                {
                    set_persistent_option($buffer, 'conflicts-present', 1);
                }
            }
            elsif ($ipcType == IPC::MODULE_UPTODATE)
            {
                # Properly account for users manually doing --refresh-build or
                # using .refresh-me.
                if (needs_refreshed($module))
                {
                    $svn_status{$buffer} = 'success';
                    note "\tNo source update, but g[$module] meets other building criteria.";
                }
                else
                {
                    $svn_status{$buffer} = 'skipped';
                }
            }
        }

        next if $svn_status{$module} eq 'failed';

        # Skip actually building a module if the user has selected to skip
        # builds when the source code was not actually updated. But, don't skip
        # if we didn't successfully build last time.
        if (!get_option($module, 'build-when-unchanged') &&
            $svn_status{$module} eq 'skipped' &&
            get_persistent_option($module, 'failure-count') == 0)
        {
            note "\tSkipping g[$module], its source code has not changed.";
            $i++;
            next;
        }

        if (build_module ($module))
        {
            my $elapsed = prettify_seconds(time - $start_time);
            print STATUS_FILE "$module: Succeeded after $elapsed.\n" if $outfile;
            set_persistent_option($module, 'last-build-rev', current_module_revision($module));
            set_persistent_option($module, 'failure-count', 0);

            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;

            # Increment failed count to track when to start bugging the
            # user to fix stuff.

            my $fail_count = get_persistent_option($module, 'failure-count');
            $fail_count = 0 unless defined $fail_count;
            ++$fail_count;
            set_persistent_option($module, 'failure-count', $fail_count);

            if (get_option($module, 'stop-on-failure'))
            {
                note "\n$module didn't build, stopping here.";
                return 1; # Error
            }
        }

        $i++;
    }
    continue # Happens at the end of each loop and on next
    {
        print "\n"; # Space things out
    }

    # 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;

        # Update the symlink in latest to point to this file.
        my $logdir = get_subdir_path('global', 'log-dir');
        if (-l "$logdir/latest/build-status") {
            safe_unlink("$logdir/latest/build-status");
        }
        symlink($outfile, "$logdir/latest/build-status");
    }

    info "<<<  Build Done  >>>";
    info "\n<<<  g[PACKAGES SUCCESSFULLY BUILT]  >>>" if scalar @build_done > 0;

    if (not pretending)
    {
        # Print out results, and output to a file
        my $kdesrc = get_source_dir();
        open BUILT_LIST, ">$kdesrc/successfully-built";
        foreach my $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'}} or grep (/failed/, values %svn_status);
}

# Subroutine checks to see if a module is present in the config file, and
# warns if it is not.  It does this by checking whether it has any options set,
# and if not, will set a default value for the options.
# First parameter: name of module to check.
sub check_for_module_config
{
    my $module = shift;

    if (not exists $package_opts{$module})
    {
        warning <<EOF;
 b[y[*]
 b[y[*] Unknown module y[$module], configure it in $rcfile.
 b[y[*]
EOF
        $package_opts{$module} = default_module_options($module);
    }

    # This can happen if there *is* a config specified but the user
    # did not specify a repository option.  We can't default it in
    # global because once KDE switches the default would be wrong.
    if ($module eq 'qt-copy' and not get_option($module, 'repository')) {
        set_option($module, 'repository', 'git://gitorious.org/qt/qt.git');
    }
}

# 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;

    write_persistent_options();

    exit $exitcode if pretending; # Abort early when pretending.

    close_lock();

    open(LOG, ">>$logdir/build-log");
    local $, = "\n"; # Change item separator to newline for output.
    print LOG @screen_log;
    close(LOG);

    eval { plugin_finish($logdir); };

    note "Your logs are saved in y[$logdir]";
    exit $exitcode;
}

# Subroutine to determine the current repository URL for the given module.
sub get_repo_url
{
    my $module = shift;
    return get_svn_info($module, 'URL');
}

# module-base-path handling changed with kdesvn-build 1.8.  This function
# returns true for a given module if it looks like it is checked out with
# module-base-path from an older version of kdesvn-build.
sub module_base_path_changed
{
    my $module = shift;

    if (get_option($module, 'module-base-path'))
    {
        # If the on disk URL ends in module name but module-base-path doesn't
        # then this is probably the problem due to the version change.
        my $modulename = moduleBaseName($module);
        if (get_option($module, 'module-base-path') !~ /\/$modulename$/ &&
            get_repo_url($module) =~ /\/$modulename$/)
        {
            return 1;
        }
    }

    return 0;
}

# 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
{
    my $module = shift;
    my $source_dir = get_fullpath($module, 'source');
    my $module_expected_url = svn_module_url($module);

    my $module_actual_url = get_repo_url($module);

    eval { plugin_check_module_validity($module, $module_actual_url, $module_expected_url); };

    if (exists $ENV{'COVERITY_RUN'} and $module_actual_url ne $module_expected_url)
    {
        warning "Something is wrong with your $module. Let's see if we can correct it. ";
        warning "kdesrc-build expects:        y[$module_expected_url]";
        warning "The module is actually from: y[$module_actual_url]";

        system("svn status --no-ignore | grep '^[I?]' | cut -b8- | xargs rm -rf");
        log_command($module, 'svn-switch', ['svn', 'switch', $module_expected_url]);
        return;
    }

    if ($module_actual_url ne $module_expected_url)
    {
        # Check if the --svn-only flag was passed.
        if (get_option('global', '#manual-build') and not
            module_base_path_changed($module))
        {
            note "g[$module] is checked out from a different location than expected.";
            note "Attempting to correct";

            log_command($module, 'svn-switch', ['svn', 'switch', $module_expected_url]);
            return;
        }

        warning <<EOF;
 y[!!]
 y[!!] g[$module] seems to be checked out from somewhere other than expected.
 y[!!]

kdesrc-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.

If you use kdesrc-build with --src-only it will try switching for you (might not work
correctly).
EOF
        if (module_base_path_changed($module))
        {
            my $basePath = get_option($module, 'module-base-path');
            warning <<EOF;
 y[*] r[*] y[*] NOTE: This warning is probably due to a change in the handling of the
 y[module-base-path] option in kdesrc-build 1.8.  You must now add the module
 name to the end for some modules (this change was required because some KDE
 modules no longer end in the module name).

 For instance, if you previously had:
 module $module
   module-base-path $basePath
 # ...
 end module

 you now want:

 module $module
   module-base-path ${basePath}g[b[/$module]
 # ...
 end module
EOF
        }
    }
}

# Check if qt-copy 4 requires make install.
#
# This returns true unless the QTDIR is the same as the Qt 4 srcdir.
sub qt_copy_needs_installed
{
    my $builddir = get_fullpath('qt-copy', 'build');
    my $prefix = get_option('global', 'qtdir');
    return 0 if $builddir eq $prefix;
    return 1;
}

# Returns the given list of modules, excluding those that can not be
# installed or uninstalled.
sub filter_non_installable_modules
{
    my @excluded_modules = qw/kde-common/;
    push @excluded_modules, 'qt-copy' unless qt_copy_needs_installed();

    return grep {!list_has(@excluded_modules, $_)} (@_);
}

# Subroutine to handle the installation process.  Simply calls
# 'make install' in the build directory.
#
# Return value is a shell-style success code (0 == success)
sub handle_install
{
    my @modules = filter_l10n_module_list(@_);
    @modules = filter_non_installable_modules(@modules);
    my $result = 0;

    for my $module (@modules)
    {
        resetenv();
        update_module_environment ($module);
        check_for_module_config ($module);

        my $builddir = get_fullpath ($module, 'build');

        if (not pretending and not -e "$builddir/Makefile")
        {
            warning "\tThe build system doesn't exist for r[$module].";
            warning "\tTherefore, we can't install it. y[:-(].";
            next;
        }

        # We can optionally uninstall prior to installing
        # to weed out old unused files.
        if (get_option ($module, 'use-clean-install') &&
            get_persistent_option ($module, 'last-install-rev') &&
            safe_make ($module, 'uninstall'))
        {
            warning "\tUnable to uninstall r[$module] before installing the new build.";
            warning "\tContinuing anyways...";
        }

        # 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"))
        {
            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.

        set_persistent_option($module, 'last-install-rev', current_module_revision($module));

        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].";
            safe_rmtree($srcdir);
        }

        if($remove_setting eq 'builddir' or $remove_setting eq 'all')
        {
            # Remove builddir
            note "\tRemoving b[r[$module build directory].";
            safe_rmtree($builddir);
        }
    }

    return $result;
}

# Subroutine to handle the installation process.  Simply calls
# 'make uninstall' in the build directory, assuming that Qt or
# CMake can actually handle it.
#
# The order of the modules is often significant, in the case of
# this function the modules are uninstalled IN THE OPPOSITE ORDER
# than passed in, to be more compatible with the rest of the code.
#
# Return value is a shell-style success code (0 == success)
sub handle_uninstall
{
    my @modules = filter_l10n_module_list(@_);
    @modules = filter_non_installable_modules(@modules);
    my $result = 0;

    for my $module (reverse @modules)
    {
        resetenv();
        update_module_environment ($module);
        check_for_module_config ($module);

        my $builddir = get_fullpath ($module, 'build');

        if (not pretending and not -e "$builddir/Makefile")
        {
            warning "\tThe build system doesn't exist for r[$module].";
            warning "\tTherefore it cannot be uninstalled by this program.";
            next;
        }

        # 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, "uninstall"))
        {
            error "\tUnable to uninstall r[$module]!";
            $result = 1;
            push @{$fail_lists{'uninstall'}}, $module;

            if (get_option($module, 'stop-on-failure'))
            {
                note "y[Stopping here].";
                return 1; # Error
            }
        }

        if (pretending)
        {
            pretend "\tWould have uninstalled g[$module]";
            next;
        }

        next if $result != 0; # Don't delete anything if the build failed.
    }

    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 %module_cleared = ();

    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))
            {
                # extragear and playground both have support now for building
                # the entire cluster of modules with one make command.
                if (scalar @dirs == 0)
                {
                    whisper "Building all of g[$modulename]."
                }

                $modulename .= "/" . shift @dirs unless scalar @dirs == 0;
            }

            if (scalar @dirs > 0)
            {
                # Only build the specified subdirs
                if (not exists $module_cleared{$modulename})
                {
                    debug "Clearing checkout-only option for $modulename.";

                    $module_cleared{$modulename} = 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;

                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 "\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');

    if (not defined $file or not $file)
    {
        return "No logfile for module $module.\n";
    }

    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.
    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 kdesrc-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 build compile error',
    });

    print $mailer $email_body;
    $mailer->close;
}

# Exits out of kdesrc-build, executing the user's preferred shell instead.  The
# difference is that the environment variables should be as set in kdesrc-build
# instead of as read from .bashrc and friends.
#
# Meant to implement the --shell command line option.
sub execute_command_line_program()
{
    my $program = get_option('global', '#start-program');

    if (not $program)
    {
        error "You need to specify a program with the --run option.";
        exit 1; # Can't use finish here.
    }

    if (($< != $>) and ($> == 0))
    {
        error "kdesrc-build will not run a program as root unless you really are root.";
        exit 1;
    }

    debug "Executing b[r[$program] ", join(' ', @ARGV);

    exit 0 if pretending;

    exec $program, @ARGV or do {
        # If we get to here, that sucks, but don't continue.
        error "Error executing $program: $!";
        exit 1;
    };
}

# This subroutine is the monitoring process for when using PipeIPC.  It reads
# in all status reports from the source update process and then holds on
# to them.  When the build process is ready to read information we send what
# we have.  Otherwise we're waiting on the update process to send us something.
#
# This convoluted arrangement is required to allow the source update
# process to go from start to finish without undue interruption on it waiting
# to write out its status to the build process which is usually busy.
#
# First parameter is the IPC object to use.
#
# Returns 0 on success, non-zero on failure.
sub handle_monitoring
{
    my $ipc = shift;

    # Setup some file handle sets to use in the select() call.
    # The out ones are copies of the in ones since select() overwrites its
    # parameters.
    my ($win, $wout, $rin, $rout);
    ($win, $rin) = ("") x 2; # Get rid of undefined warnings.

    my @msgs;  # Message queue.

    # Perl uses vec() to setup the file handle sets.  Make some local
    # subroutines to make it suck less in the real code.
    sub setFdInSet($$$) {
        my ($set, $fh, $inSet) = @_;
        vec($set, fileno($fh), 1) = $inSet;
        return $set;
    }

    sub fdIsChosen($$) {
        my ($set, $fh) = @_;
        return vec($set, fileno($fh), 1) == 1;
    }

    # We will write to the build process and read from the update process.
    $win = setFdInSet($win, $ipc->{'toBuild'}, 1);
    $rin = setFdInSet($rin, $ipc->{'fromSvn'}, 1);

    # Start the loop.  We will be waiting on either $win or $rin.  Whenever
    # select() returns we must check both sets.
    for(;;)
    {
        my $numFound = select($rout = $rin, $wout = $win, undef, undef);

        if ($numFound == -1)
        {
            error "r[mon]: Monitor IPC error: r[$!]";
            return 1;
        }

        # Check for svn updates first.
        if (fdIsChosen($rout, $ipc->{'fromSvn'}))
        {
            my $msg = $ipc->receiveFromUpdater();

            # undef can be returned on EOF as well as error.  EOF means the
            # other side is presumably done.
            if (not defined $msg and not $!)
            {
                $rin = setFdInSet($rin, $ipc->{'fromSvn'}, 0);
                last; # Select no longer needed, just output to build.
            }

            # Don't check for $! first, it seems to always be set to EBADF.
            # Probably I'm screwing up the select() call?
            if (defined $msg)
            {
                push @msgs, $msg;
            }
            else
            {
                error "r[mon]: Error reading update: r[b[$!]";
                return 1;
            }
        }

        # Now check for build updates.
        if (fdIsChosen($wout, $ipc->{'toBuild'}))
        {
            # If we're here the update is still going.  If we have no messages
            # to send wait for that first.
            if (not @msgs)
            {
                my ($rout2, $numFound2);
                $numFound2 = select($rout2 = $rin, undef, undef, undef);

                if ($numFound2 == -1 and $!)
                {
                    error "r[mon]: Monitor IPC error: r[$!]";
                    return 1;
                }

                # Assume EOF can happen here.
                my $msg = $ipc->receiveFromUpdater();
                if (not defined $msg and $!)
                {
                    error "r[mon]: Monitor IPC error, unexpected disappearance of updater.";
                    error "r[mon]: Mysterious circumstances: r[b[$!]";
                    return 1;
                }

                push @msgs, $msg if $msg;
            }

            # Send the message (if we got one).
            if (scalar @msgs and !$ipc->sendToBuilder(shift @msgs))
            {
                error "r[mon]: Build process stopped too soon! r[$!]";
                return 1;
            }
        }
    }

    # Send all remaining messages.
    while (@msgs)
    {
        if (!$ipc->sendToBuilder(shift @msgs))
        {
            error "r[mon]: Build process stopped too soon! r[$!]";
            return 1;
        }
    }

    return 0;
}

# This subroutine performs the update and build process asynchronously.
#
# Only one thread or process of execution will return from this procedure.
#
# The first parameter should be the IPC object to use, which must support
# concurrency.
#
# Returns 0 on success, non-zero on failure.
sub handle_async_build
{
    # The exact method for async is that two children are forked.  One child
    # is a svn update process.  The other child is a monitor process which will
    # hold status updates from the svn process so that the svn updates may
    # happen without waiting for us to be ready to read.

    my $ipc = shift;

    my $svnPid = fork;
    if ($svnPid == 0)
    { # child
        $ipc->setUpdater();
        exit handle_updates ($ipc);
    }

    # Parent
    my $monPid = fork;
    if ($monPid == 0)
    { # monitor
        $ipc->setMonitor();
        exit handle_monitoring ($ipc);
    }

    # Still the parent, let's do the build.
    $ipc->setBuilder();
    my $result = handle_build ($ipc);

    # Exit code is in $?.
    waitpid ($svnPid, 0);
    $result = 1 if $? != 0;

    waitpid ($monPid, 0);
    $result = 1 if $? != 0;

    return $result;
}

# Returns the unique entries in the given list, original ordering is not
# maintained.
sub unique_list
{
    my @entries = sort @_;
    my @result;
    my $last = '';

    for my $entry (@entries) {
        next if ((not defined $entry) || ($last eq $entry));

        push @result, $entry;
        $last = $entry;
    }

    return @result;
}

# Returns a list of module directory IDs that must be kept due to being
# referenced from the "latest" symlink.  It should be called with the "latest"
# directory that is a standard subdirectory of the log directory.
#
# First parameter is the directory to search under for symlinks.  This
# subroutine will call itself recursively if necessary to search under the given
# directory.  Any symlinks are read to see which log directory is pointed to.
sub needed_module_logs
{
    my $logdir = shift;
    my @dirs;

    # A lexicalized var (my $foo) is required in face of recursiveness.
    opendir(my $fh, $logdir) || die "Can't opendir $logdir: $!";
    my $dir = readdir($fh);

    while(defined $dir) {
        if (-l "$logdir/$dir") {
            my $link = readlink("$logdir/$dir");
            push @dirs, $link;
        }
        elsif ($dir !~ /^\.{1,2}$/) {
            # Skip . and .. directories (this is a great idea, trust me)
            push @dirs, needed_module_logs("$logdir/$dir");
        }
        $dir = readdir $fh;
    }

    closedir $fh;

    # Convert directory names to numeric IDs.
    @dirs = map { m/(\d{4}-\d\d-\d\d-\d\d)/ } (@dirs);
    return unique_list(@dirs);
}

# This function removes log directories from old kdesrc-build runs.  All log
# directories not referenced by $log_dir/latest somehow are made to go away.
sub cleanup_log_directory
{
    my $logdir = get_subdir_path('global', 'log-dir');

    # This glob relies on the date being in the specific format YYYY-MM-DD-ID
    my @dirs = bsd_glob("$logdir/????-??-??-??/", GLOB_NOSORT);
    my @needed = needed_module_logs("$logdir/latest");

    # Convert a list to a hash lookup since Perl lacks a "list-has"
    my %needed_table;
    @needed_table{@needed} = (1) x @needed;

    my $length = scalar @dirs - scalar @needed;
    if ($length > 15) { # Arbitrary man is arbitrary
        note "Removing y[b[$length] out of g[b[$#dirs] old log directories (this may take some time)...";
    }
    elsif ($length > 0) {
        info "Removing g[b[$length] out of g[b[$#dirs] old log directories...";
    }

    for my $dir (@dirs) {
        my ($id) = ($dir =~ m/(\d\d\d\d-\d\d-\d\d-\d\d)/);
        safe_rmtree($dir) unless $needed_table{$id};
    }
}

# Script starts.

# Adding in a way to load all the functions without running the program to
# enable some kind of automated QA testing.
if (__PACKAGE__ eq 'test')
{
    print "kdesrc-build being run from testing framework, BRING IT.\n";
    print "kdesrc-build is version $versionNum\n";
    return 1;
}

# Use some exception handling to avoid ucky error messages
eval
{
    # Note: Don't change the order around unless you're sure of what you're
    # doing.
    set_debug_colors();  # Default to colorized output if sending to TTY
    process_arguments(); # Process --help, --install, etc. first.
    read_options();      # If we're still here, read the options
    update_module_environment('global'); # Initialize global env vars.

    # Check if we're supposed to drop into an interactive shell instead.  If so,
    # here's the stop off point.

    if (get_option('global', '#start-program'))
    {
        execute_command_line_program();
    }

    setup_operating_environment(); # i.e. niceness, ulimits, etc.
    setup_logging_subsystem(); # Setup logging directories.

    if (get_option('global', 'kde-languages'))
    {
        # Just set some optionsto init defaults.
        set_option('l10n-kde4', 'install-after-build', 1);
    }

    dump_options() if debugging;
};

if ($@)
{
    if ($@->isa('BuildException')) {
        print $@->{'exception_type'}, " error: ", $@->{'message'}, "\n";
        print "\tCan't continue, so stopping now.\n";
    }
    else {
        # 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 kdesrc-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]" unless pretending;

    # Read in persistent data for i.e. tracking the revision of the last
    # successful svn update or build.
    read_persistent_options();

    # Coverity doesn't respond to email as often as we'd like, but we can
    # usually work around that here.
    if (exists $ENV{'COVERITY_RUN'} )
    {
        info "Fixing the Build by downloading the Coverity Patch Script.";
        if (-e "$0-coverity") {
            open(C, "< $0-coverity") or die;
        } else {
            open(C, "-|", "svn", "cat",
                "svn://anonsvn.kde.org/home/kde/trunk/KDE/kdesdk/scripts/kdesrc-build-coverity");
        }
        my @plugin = <C>;
        close(C);
        eval "@plugin" or die;
    }

    eval { plugin_setup_default_modules(\@update_list, \@build_list, \%package_opts); };
    $@ = ''; # Clear errors that result when not using Coverity plugin.

    @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.
    # kdelibs/khtml, and the script will only try to update that part of
    # the module.  This also updates for the l10n module (kde-languages option)
    munge_lists();

    if ($run_mode eq 'build')
    {
        # No packages to install, we're in build mode

        # What we're going to do is fork another child to perform the svn
        # updates while we build.  Setup for this first by initializing some
        # shared memory.  In case of Coverity, set this to 0 that way we get
        # NullIPC, even if the SysVIPC ctor fails.
        my $ipc = 0;

        if(not exists $ENV{'COVERITY_RUN'} and get_option('global', 'async'))
        {
            $ipc = new PipeIPC;
        }

        if (not $ipc)
        {
            $ipc = new NullIPC;
            whisper "Using no IPC mechanism\n";

            $result = handle_updates ($ipc);
            $result = handle_build ($ipc) || $result;
        }
        else
        {
            $result = handle_async_build ($ipc);
        }
    }
    elsif ($run_mode eq 'install')
    {
        # Installation mode
        $result = handle_install (get_install_list());
    }
    elsif ($run_mode eq 'uninstall')
    {
        # Use build list since that's likely what the user has recently built
        # and installed.
        $result = handle_uninstall (get_uninstall_list());
    }

    cleanup_log_directory() if get_option('global', 'purge-old-logs');
    output_failed_module_lists();
    email_error_report();

    $time = localtime;
    my $color = '';
    $color = 'r[' if $result;

    info "${color}Script finished processing at g[$time]" unless pretending;
};

if ($@)
{
    # We encountered an error.
    if ($@->isa('BuildException')) {
        print "\tCaught exception: ", $@->{'message'}, "\n";
        print "\n\tAborting.\n";
    }
    else {
        print "Encountered an error in the execution of the script.\n";
        print "The error reported was $@\n";
        print "Please submit a bug against kdesrc-build on http://bugs.kde.org/\n";
    }

    $result = 99;
}

finish($result);

# vim: set et sw=4 ts=4: