#!/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,
# in the doc/ directory.
#
# Copyright © 2003 - 2011 Michael Pyne. <mpyne@kde.org>
# Home page: http://kdesrc-build.kde.org/
#
# Copyright © 2005, 2006, 2008 - 2011 David Faure <faure@kde.org>
# Copyright © 2005 Thiago Macieira <thiago@kde.org>
# Copyright © 2006 Stephan Kulow <coolo@kde.org>
# Copyright © 2006, 2008 Dirk Mueller <mueller@kde.org>
# ... and possibly others. Check the git source repository for specifics.
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 51
# Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

# Force all symbols to be in this package. We can tell if we're being called
# through require/eval/etc. by using the "caller" function.
package main;

use strict;
use warnings;
use Fcntl;    # For sysopen constants
use Carp;
use POSIX qw(strftime :sys_wait_h);
use File::Find; # For our lndir reimplementation.
use File::Path qw(make_path remove_tree);
use File::Glob ':glob';
use File::Basename; # fileparse
use LWP::UserAgent;
use URI; # For git-clone snapshot support
use Sys::Hostname;
use Storable 'dclone';
use IO::Handle;
use IPC::Open3;
use Errno qw(:POSIX);
use Data::Dumper;
use 5.010_000; # Require Perl 5.10.0

# global variables {{{1

use constant {
    # We use a named remote to make some git commands work that don't accept the
    # full path.
    GIT_REMOTE_ALIAS => 'origin',
    KDE_PROJECT_ID   => 'kde-projects',          # git-repository-base for kde_projects.xml
};

my $versionNum = '1.14.1';

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

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

my $run_mode = 'build'; # Determines if updating, building, installing, etc.

# }}}

# package IPC {{{
{
    # 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,
    };
}
# }}}

# package ksb::Debug {{{
{
    package ksb::Debug;

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

    my $screenLog;   # Filehandle pointing to the "build log".
    my $isPretending = 0;
    my $debugLevel = INFO;

    # Colors
    my ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = ("") x 5;

    # Subroutine definitions

    sub import
    {
        my $pkg = shift;
        my $caller = caller;
        my @exports = qw(debug pretending debugging whisper
                         note info warning error pretend clr);

        # This loop is only slightly "magical". Basically to import functions
        # into a different package in Perl, we can use something like:
        # *PACKAGE::FUNCTION = \&SOURCE_PACKAGE::FUNCTION;
        # where the *PACKAGE modifies the symbol table for that package.
        #
        # The extra part, which requires using eval, is to predeclare the
        # subroutine with a prototype first.
        # "sub foo($old_prototype);"

        for my $fn (@exports) {
            my $prototype = prototype($fn);
            eval "sub ${caller}::${fn}(${prototype});\n" .
                 "*${caller}::${fn} = \\&${pkg}::${fn};";
        }
    }

    # I'm lazy and would rather write in shorthand for the colors.  This sub
    # allows me to do so.
    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 $isPretending;
    }

    sub setPretending
    {
        $isPretending = shift;
    }

    sub setColorfulOutput
    {
        # No colors unless output to a tty.
        return unless -t STDOUT;

        my $useColor = shift;

        if ($useColor) {
            $RED = "\e[31m";
            $GREEN = "\e[32m";
            $YELLOW = "\e[33m";
            $NORMAL = "\e[0m";
            $BOLD = "\e[1m";
        }
        else {
            ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = ("") x 5;
        }
    }

    # 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 $debugLevel <= DEBUG;
    }

    sub setDebugLevel
    {
        $debugLevel = shift;
    }

    sub setLogFile
    {
        my $fileName = shift;

        return if pretending();
        open ($screenLog, '>', $fileName) or error ("Unable to open log file $fileName!");
    }

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

        if (defined $screenLog) {
            my @savedColors = ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD);
            # Remove color but still extract codes
            ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = ("") x 5;

            print ($screenLog clr($_)) foreach (@_);
            print ($screenLog "\n");

            ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = @savedColors;
        }
    }

    sub debug(@)
    {
        print_clr(@_) if debugging;
    }

    sub whisper(@)
    {
        print_clr(@_) if $debugLevel <= WHISPER;
    }

    sub info(@)
    {
        print_clr(@_) if $debugLevel <= INFO;
    }

    sub note(@)
    {
        print_clr(@_) if $debugLevel <= NOTE;
    }

    sub warning(@)
    {
        print_clr(@_) if $debugLevel <= WARNING;
    }

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

    sub pretend(@)
    {
        print_clr(@_) if pretending;
    }

    1;
}

# }}}

# package ksb::Util {{{
{
    package ksb::Util;

    use Carp;
    use Scalar::Util qw(blessed);

    sub import
    {
        my $pkg = shift;
        my $caller = caller;
        my @exports = qw(list_has make_exception assert_isa assert_in);

        # This loop is only slightly "magical". Basically to import functions
        # into a different package in Perl, we can use something like:
        # *PACKAGE::FUNCTION = \&SOURCE_PACKAGE::FUNCTION;
        # where the *PACKAGE modifies the symbol table for that package.
        #
        # The extra part, which requires using eval, is to predeclare the
        # subroutine with a prototype first.
        # "sub foo($old_prototype);"

        for my $fn (@exports) {
            my $prototype = prototype($fn);
            if ($prototype) {
                eval "sub ${caller}::${fn}(${prototype});\n" .
                     "*${caller}::${fn} = \\&${pkg}::${fn};";
            }
            else {
                eval "*${caller}::${fn} = \\&${pkg}::${fn};";
            }
        }
    }

    # 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 $value = pop;
        # Expand list references if present, otherwise use all params.
        my @list = scalar @_ == 1 ? @{$_[0]} : @_;
        return scalar grep { "$_" eq "$value" } (@list);
    }

    # 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. Recommended are one of: Config, Internal
    # (for logic errors), Runtime (other runtime errors which are not logic
    # bugs in kdesrc-build), or just leave blank for 'Exception'.
    # 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 // 'Exception';
        my $message = shift;

        return bless({
            'exception_type' => $exception_type,
            'message'        => $message
        }, 'BuildException');
    }

    # Used in the assert methods
    sub fail_assertion
    {
        # Carp doesn't support exception objects, so raise the error
        # message and grab the string for the stack trace, then re-raise
        # inside the object.
        local $Carp::CarpLevel = 2; # Skip this upcoming eval and this method.
        eval { confess ($_[0]) };
        die(make_exception('Internal', $@));
    }

    # Throws an exception if the first parameter is not an object at all, or if
    # it is not an object of the type given by the second parameter (which
    # should be a string of the class name. There is no return value;
    sub assert_isa
    {
        my ($obj, $class) = @_;

        if (!blessed($obj) || !$obj->isa($class)) {
            fail_assertion("$obj is not of type $class");
        }

        return $obj;
    }

    # Throws an exception if the first parameter is not included in the
    # provided list of possible alternatives.
    sub assert_in($@)
    {
        my ($val, $listRef) = @_;

        if (!list_has(@{$listRef}, $val)) {
            fail_assertion("$val is not a permissible value for its argument");
        }

        return $val;
    }

    1;
}
# }}}

# package BaseIPC {{{
# 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;
    }
}
# }}}

# package PipeIPC {{{
# 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');
    }
}
# }}}

# package NullIPC {{{
# 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'}};
    }
}
# }}}

# package KDEXMLReader {{{
# kde_projects.xml module-handling code.
# The core of this was graciously contributed by Allen Winter, and then
# touched-up and kdesrc-build'ed by myself -mpyne.
{
    package KDEXMLReader;
    use XML::Parser;

    my @nameStack = ();        # Used to assign full names to modules.
    my %xmlGroupingIds;        # XML tags which group repositories.
    my @modules;               # Result list
    my $curRepository;         # ref to hash table when we are in a repo
    my $trackingReposFlag = 0; # >0 if we should be tracking for repo elements.
    my $inRepo = 0;            # >0 if we are actually in a repo element.
    my $repoFound = 0;         # If we've already found the repo we need.
    my $searchProject = '';    # Project we're looking for.

    # Note on searchProject: A /-separated path is fine, in which case we look
    # for the right-most part of the full path which matches all of searchProject.
    # e.g. kde/kdebase/kde-runtime would be matched searchProject of either
    # "kdebase/kde-runtime" or simply "kde-runtime".
    sub getModulesForProject
    {
        # These are the elements that can have <repo> under them AFAICS, and
        # participate in module naming. e.g. kde/calligra or
        # extragear/utils/kdesrc-build
        @xmlGroupingIds{qw/component module project/} = 1;

        my ($class, $proj, $srcdir) = @_;

        $searchProject = $proj;
        @modules = ();
        @nameStack = ();
        $inRepo = 0;
        $trackingReposFlag = 0;
        $curRepository = undef;

        my $parser = XML::Parser->new(
            Handlers =>
                {
                    Start => \&xmlTagStart,
                    End => \&xmlTagEnd,
                    Char => \&xmlCharData,
                },
        );

        my $result = $parser->parsefile("$srcdir/kde_projects.xml");
        return @modules;
    }

    sub xmlTagStart
    {
        my ($expat, $element, %attrs) = @_;

        # In order to ensure that repos which are recursively under this node are
        # actually handled, we increment this flag if it's already >0 (which means
        # we're actively tracking repos for some given module).
        # xmlTagEnd will then decrement the flag so we eventually stop tracking
        # repos once we've fully recursively handled the node we cared about.
        if ($trackingReposFlag > 0) {
            ++$trackingReposFlag;
        }

        if (exists $xmlGroupingIds{$element}) {
            push @nameStack, $attrs{'identifier'};

            # If we're not tracking something, see if we should be. The logic is
            # fairly long-winded but essentially just breaks searchProject into
            # its components and compares it item-for-item to the end of our name
            # stack.
            if ($trackingReposFlag <= 0) {
                my @searchParts = split(m{/}, $searchProject);
                if (scalar @nameStack >= scalar @searchParts) {
                    my @candidateArray = @nameStack[-(scalar @searchParts)..-1];
                    die "candidate vs. search array mismatch" if $#candidateArray != $#searchParts;

                    $trackingReposFlag = 1;
                    for (my $i = 0; $i < scalar @searchParts; ++$i) {
                        if (($searchParts[$i] ne $candidateArray[$i]) &&
                            ($searchParts[$i] ne '*'))
                        {
                            $trackingReposFlag = 0;
                            last;
                        }
                    }

                    # Reset our found flag if we're looking for another repo
                    $repoFound = 0 if $trackingReposFlag > 0;
                }
            }
        }

        # Checking that we haven't already found a repo helps us out in
        # situations where a supermodule has its own repo, -OR- you could build
        # it in submodules. We won't typically want to do both, so prefer
        # supermodules this way. (e.g. Calligra and its Krita submodules)
        if ($element eq 'repo' &&     # Found a repo
            $trackingReposFlag > 0 && # When we were looking for one
            ($trackingReposFlag <= $repoFound || $repoFound == 0))
                # (That isn't a direct child of an existing repo)
        {
            die "We are already tracking a repository" if $inRepo > 0;
            $inRepo = 1;
            $repoFound = $trackingReposFlag;
            $curRepository = {
                'fullName' => join('/', @nameStack),
                'repo' => '',
                'name' => $nameStack[-1],
                'active' => 'false',
                'tarball' => '',
            }; # Repo/Active/tarball to be added by char handler.
        }

        # Character data is integrated by the char handler. To avoid having it dump
        # all willy-nilly into our dict, we leave a flag for what the resultant key
        # should be.
        if ($element eq 'active' && $inRepo) {
            $curRepository->{'needs'} = 'active';
        }

        if ($element eq 'url' && $inRepo && $attrs{'protocol'} eq 'git') {
            $curRepository->{'needs'} = 'repo';
        }

        if ($element eq 'url' && $inRepo && $attrs{'protocol'} eq 'tarball') {
            $curRepository->{'needs'} = 'tarball';
        }
    }

    sub xmlTagEnd
    {
        my ($expat, $element) = @_;

        if (exists $xmlGroupingIds{$element}) {
            pop @nameStack;
        }

        if ($element eq 'repo' && $inRepo) {
            $inRepo = 0;
            push @modules, $curRepository;
            $curRepository = undef;
        }

        # See xmlTagStart above for an explanation.
        --$trackingReposFlag;
    }

    sub xmlCharData
    {
        my ($expat, $utf8Data) = @_;

        if ($curRepository && defined $curRepository->{'needs'}) {
            $curRepository->{$curRepository->{'needs'}} = $utf8Data;
            delete $curRepository->{'needs'};
        }
    }

    1;
}
# }}}

# package ksb::Phases {{{
{
    # Handles the "phases" for kdesrc-build, e.g. a simple list of phases,
    # and methods to add, clear, or filter out phases.
    package ksb::Phases;

    ksb::Util->import();

    # Constructor. Passed in values are the initial phases in this set.
    sub new
    {
        my ($class, @args) = @_;
        return bless [@args], $class;
    }

    # Filters out the given phase from the current list of phases.
    sub filterOutPhase
    {
        my ($self, $phase) = @_;
        @{$self} = grep { $_ ne $phase } @{$self};
    }

    # Adds the requested phase to the list of phases to build.
    sub addPhase
    {
        my ($self, $phase) = @_;
        push @{$self}, $phase unless list_has([@{$self}], $phase);
    }

    # Get/sets number of phases depending on whether any are passed in.
    sub phases
    {
        my ($self, @args) = @_;
        @$self = @args if scalar @args;
        return @$self;
    }

    sub clear
    {
        my $self = shift;
        splice @$self;
    }

    1;
}
# }}}

# package ksb::BuildContext {{{
{
    # This contains the information needed about the build context, e.g.
    # list of modules, what phases each module is in, the various options,
    # etc.
    package ksb::BuildContext;

    use Carp 'confess';
    use File::Basename; # dirname
    use IO::File;
    use POSIX qw(strftime);

    # We derive from Module so that BuildContext acts like the 'global'
    # Module, with some extra functionality.
    our @ISA = qw(Module);

    # This is the second-half of "use Foo". The first-half is "require Foo" but
    # we already have ksb::Debug loaded above.
    ksb::Debug->import();

    ksb::Util->import();

    my @DefaultPhases = qw/update build install/;
    my @rcfiles = ("./kdesrc-buildrc", "$ENV{HOME}/.kdesrc-buildrc");

    # defaultGlobalOptions {{{2
    my %defaultGlobalOptions = (
        "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"          => ksb::Debug::INFO,
        "delete-my-patches"    => 0, # Should only be set from cmdline
        "dest-dir"             => '${MODULE}', # single quotes used on purpose!
        "disable-agent-check"  => 0,   # If true we don't check on ssh-agent
        "do-not-compile"       => "",
        "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"       => 1,
        "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,
    );
    # }}} 1

    sub new
    {
        my ($class, @args) = @_;

        # It is very important to use the Module:: syntax instead of Module->,
        # otherwise you can't pass $class and have it used as the classname.
        my $self = Module::new($class, undef, 'global');
        my %newOpts = (
            modules => [],
            context => $self, # Fix link to buildContext (i.e. $self)
            build_options => {
                global => \%defaultGlobalOptions,
                # Module options are stored under here as well, keyed by module->name()
            },
            # This one replaces Module::{phases}
            phases  => ksb::Phases->new(@DefaultPhases),
            errors  => {
                # Phase names from phases map to a references to a list of failed Modules
                # from that phase.
            },
            logPaths=> {
                # Holds a hash table of log path bases as expanded by
                # get_subdir_path (e.g. [source-dir]/log) to the actual log dir
                # *this run*, with the date and unique id added. You must still
                # add the module name to use.
            },
            rcFiles => [@rcfiles],
            rcFile  => undef,
        );

        # Merge all new options into our self-hash.
        @{$self}{keys %newOpts} = values %newOpts;
        $self->{options} = $self->{build_options}{global};

        assert_isa($self, 'Module');
        assert_isa($self, 'ksb::BuildContext');

        return $self;
    }

    # Gets the ksb::Phases for this context, and optionally sets it first to
    # the ksb::Phases passed in.
    sub phases
    {
        my ($self, $phases) = @_;

        if ($phases) {
            confess("Invalid type, expected Phases")
                unless $phases->isa('ksb::Phases');
            $self->{phases} = $phases;
        }
        return $self->{phases};
    }

    sub addModule
    {
        my ($self, $module) = @_;
        Carp::confess("No module to push") unless $module;

        if (list_has($self->{modules}, $module)) {
            debug("Skipping duplicate module ", $module->name());
        }
        else {
            debug("Adding ", $module->name(), " to module list");
            push @{$self->{modules}}, $module;
        }
    }

    sub moduleList
    {
        my $self = shift;
        return $self->{modules};
    }

    sub setupOperatingEnvironment
    {
        my $self = shift;
        # Set the process priority
        POSIX::nice(int $self->getOption('niceness'));

        # Set the IO priority if available.
        if ($self->getOption('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...");
            }
        }

        # Get ready for logged output.
        ksb::Debug::setLogFile($self->getLogDirFor($self) . '/build-log');
    }

    # This subroutine accepts a Module parameter, and returns the log directory
    # for it. You can also pass a BuildContext (including this one) to get the
    # default log directory.
    #
    # As part of setting up what path to use for the log directory, the
    # 'latest' symlink will also be setup to point to the returned log
    # directory.
    sub getLogDirFor
    {
        my ($self, $module) = @_;

        my $baseLogPath = main::get_subdir_path($module, 'log-dir');
        my $logDir;

        if (!exists $self->{logPaths}{$baseLogPath}) {
            # No log dir made for this base, do so now.
            my $id = '01';
            my $date = strftime "%F", localtime; # ISO 8601 date
            $id++ while -e "$baseLogPath/$date-$id";
            $self->{logPaths}{$baseLogPath} = "$baseLogPath/$date-$id";
        }

        $logDir = $self->{logPaths}{$baseLogPath};
        return $logDir if pretending();

        main::super_mkdir($logDir) unless -e $logDir;

        # No symlink munging or module-name-adding is needed for the default
        # log dir.
        return $logDir if $module->isa('ksb::BuildContext');

        # Add a symlink to the latest run for this module.  'latest' itself is
        # a directory under the default log directory that holds module
        # symlinks, pointing to the last log directory run for that module.  We
        # do need to be careful of modules that have multiple directory names
        # though (like extragear/foo).

        my $latestPath = "$baseLogPath/latest";

        # Handle stuff like playground/utils or KDE/kdelibs
        my ($moduleName, $modulePath) = fileparse($module->name());
        $latestPath .= "/$modulePath" if $module->name() =~ m(/);

        main::super_mkdir($latestPath);

        my $symlinkTarget = "$logDir/$moduleName";
        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);
        }

        main::super_mkdir($symlinkTarget);
        return $symlinkTarget;
    }

    # Returns rc file in use. Call loadRcFile first.
    sub rcFile
    {
        my $self = shift;
        return $self->{rcFile};
    }

    # Forces the rc file to be read from to be that given by the first
    # parameter.
    sub setRcFile
    {
        my ($self, $file) = @_;
        $self->{rcFiles} = [$file];
        $self->{rcFile} = undef;
    }

    # Returns an open filehandle to the user's chosen rc file.  Use setRcFile
    # to choose a file to load before calling this function, otherwise
    # loadRcFile will search the default search path.  After this function is
    # called, rcFile() can be used to determine which file was loaded.
    #
    # If unable to find or open the rc file an exception is raised. Empty rc
    # files are supported however.
    #
    # TODO: Support a fallback default rc file.
    sub loadRcFile
    {
        my $self = shift;
        my @rcFiles = @{$self->{rcFiles}};
        my $fh;

        for my $file (@rcFiles)
        {
            if (open ($fh, '<', "$file"))
            {
                $self->{rcFile} = $file;
                return $fh;
            }
        }

        # If still here, no luck.
        if (scalar @rcFiles == 1)
        {
            # This can only happen if the user uses --rc-file, so if we fail to
            # load the file, we need to fail to load at all.
            my $failedFile = $rcFiles[0];

            error (<<EOM);
Unable to open config file $failedFile

Script stopping here since you specified --rc-file on the command line to
load $failedFile 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 $failedFile");
        }

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

        my $data = ''; # TODO: Point to sane default.
        open ($fh, '<', \$data);
        return $fh;
    }

    sub whineForMissingConfig
    {
        my $self = shift;
        my $searched = join ("\n    ", @{$self->{rcFiles}});
        my $homepage = "http://kdesrc-build.kde.org/";

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

You should create a configuration file. The file kdesrc-buildrc-sample should
be included with your kdesrc-build package, which you can copy to
~/.kdesrc-buildrc and edit from there.

If the b[kdesrc-build-setup] program is installed, you can run that program
to quickly generate a simple configuration to get started.
HOME
    }

    sub modulesInPhase
    {
        my ($self, $phase) = @_;
        my @list = grep { list_has([$_->phases()->phases()], $phase) } (@{$self->moduleList()});
        return @list;
    }

    # Searches for a module with a name that matches the provided parameter,
    # and returns its Module object. Returns undef if no match was found.
    # As a special-case, returns the BuildContext itself if the name passed is
    # 'global', since the BuildContext also is a (in the "is-a" OOP sense)
    # Module, specifically the 'global' one.
    sub lookupModule
    {
        my ($self, $moduleName) = @_;

        return $self if $moduleName eq 'global';

        my @options = grep { $_->name() eq $moduleName } (@{$self->moduleList()});
        return undef unless @options;

        if (scalar @options > 1) {
            die make_exception('Internal', 'Detected 2 or more kdelibs Module objects');
        }

        return $options[0];
    }

    # This subroutine setups a default set of modules to be updated and built,
    # and handles setting up their initial options (also just chosen by
    # default).
    #
    # 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()
    {
        my $self = shift;

        # TODO: Move this to the build-support git repo.
        my @defaultModuleList = qw(
            qt-copy automoc cagibi attica soprano polkit-qt-1 phonon
            strigi kdesupport dbusmenu-qt
            kdelibs akonadi kdepimlibs
            kde-runtime kde-workspace kde-baseapps
            konsole kate kdeplasma-addons
            phonon-gstreamer phonon-vlc
            kdemultimedia kdeartwork kdepim kdeutils kdegraphics kdegames
            kdetoys kdeedu kdenetwork
        );

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

        my $allOptsRef = $self->{build_options};
        for my $i (@defaultModuleList) {
            my $options_ref = main::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 $allOptsRef->{$i}{$key}) {
                    $allOptsRef->{$i}{$key} = $options_ref->{$key};
                }
            }

            $self->addModule(Module->new($self, $i));
        }
    }

    sub markModulePhaseFailed
    {
        my ($self, $phase, $module) = @_;
        assert_isa($module, 'Module');

        # Make a default empty list if we haven't already marked a module in this phase as
        # failed.
        $self->{errors}{$phase} //= [ ];
        push @{$self->{errors}{$phase}}, $module;
    }

    # Returns a list (i.e. not a reference to, but a real list) of Modules that failed to
    # complete the given phase.
    sub failedModulesInPhase
    {
        my ($self, $phase) = @_;

        # The || [] expands an empty array if we had no failures in the given phase.
        return @{$self->{errors}{$phase} || []};
    }

    # Returns true if the build context has overridden the value of the given module
    # option key. Use getOption (on this object!) to get what the value actually is.
    sub hasStickyOption
    {
        my ($self, $key) = @_;
        $key =~ s/^#//; # Remove sticky marker.

        return 1 if list_has([qw/pretend disable-agent-check/], $key);
        return $self->hasOption("#$key");
    }

    # OVERRIDE: Returns one of the following:
    # 1. The sticky option overriding the option name given.
    # 2. The value of the option name given.
    # 3. The empty string (this function never returns undef).
    #
    # The first matching option is returned. See Module::getOption, which is
    # typically what you should be using.
    sub getOption
    {
        my ($self, $key) = @_;

        foreach ("#$key", $key) {
            return $self->{options}{$_} if exists $self->{options}{$_};
        }

        return '';
    }

    # OVERRIDE: Overrides Module::setOption to handle some global-only options.
    sub setOption
    {
        my ($self, %options) = @_;

        # Actually set options.
        $self->SUPER::setOption(%options);

        # Automatically respond to various global option changes.
        while (my ($key, $value) = each %options) {
            my $normalizedKey = $key;
            $normalizedKey =~ s/^#//; # Remove sticky key modifier.
            given ($normalizedKey) {
                when ('colorful-output') { ksb::Debug::setColorfulOutput($value); }
                when ('debug-level')     { ksb::Debug::setDebugLevel($value); }
                when ('pretend')         { ksb::Debug::setPretending($value); }
            }
        }
    }

    #
    # Persistent option handling
    #

    # 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 loadPersistentOptions
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');
        my $rcfile = $self->rcFile();
        my $dir = dirname($rcfile ? $rcfile : "");
        my $fh = IO::File->new("<$dir/.kdesrc-build-data");

        return unless $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
        # persistent options.

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

        # We need to keep persistent data with the context instead of with the
        # applicable modules since otherwise we might forget to write out
        # persistent data for modules we didn't build in this run. So, we just
        # store it all.
        # Layout of this data:
        #  $self->persistent_options = {
        #    'module-name' => {
        #      option => value,
        #      # foreach option/value pair
        #    },
        #    # foreach module
        #  }
        $self->{persistent_options} = $persistent_options;
    }

    # Writes out the persistent options to the file .kdesrc-build-data.
    #
    # The directory used is the same directory that contains the rc file in use.
    sub storePersistentOptions
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');
        return if pretending();

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

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

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

        $Data::Dumper::Indent = 1;
        print $fh Data::Dumper->Dump([$self->{persistent_options}], ["persistent_options"]);
        undef $fh; # Closes the file
    }

    # 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 name to get the option for, or 'global' if
    # not for a module.
    #     Note that unlike setOption/getOption, 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)
    sub getPersistentOption
    {
        my ($self, $moduleName, $key) = @_;
        my $persistent_opts = $self->{persistent_options};

        # We must check at each level of indirection to avoid
        # "autovivification"
        return unless exists $persistent_opts->{$moduleName};
        return unless exists $persistent_opts->{$moduleName}{$key};

        return $persistent_opts->{$moduleName}{$key};
    }

    # 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 name 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 setPersistentOption
    {
        my ($self, $moduleName, $key, $value) = @_;
        my $persistent_opts = $self->{persistent_options};

        # Initialize empty hash ref if nothing defined for this module.
        $persistent_opts->{$moduleName} //= { };

        $persistent_opts->{$moduleName}{$key} = $value;
    }

    1;
}
# }}}

# package Module {{{
{
    package Module;

    use Storable 'dclone';
    use Carp 'confess';
    use Scalar::Util 'blessed';
    use overload
        '""' => 'toString', # Add stringify operator.
        '<=>' => 'compare',
        ;

    ksb::Debug->import();
    ksb::Util->import();

    my $ModuleSource = 'config';

    sub new
    {
        my ($class, $ctx, $name, $type) = @_;

        confess "Empty Module constructed" unless $name;

        # If building a BuildContext instead of a Module, then the context
        # can't have been setup yet...
        my $contextClass = 'ksb::BuildContext';
        if ($class ne $contextClass &&
            (!blessed($ctx) || !$ctx->isa($contextClass)))
        {
            confess "Invalid context $ctx";
        }

        # Clone the passed-in phases so we can be different.
        my $phases = dclone($ctx->phases()) if $class eq 'Module';

        # Use a sub-hash of the context's build options so that all
        # global/module options are still in the same spot. The options might
        # already be set by read_options, but in case they're not we assign { }
        # if not already defined.
        $ctx->{build_options}{$name} //= { };

        my $module = {
            name         => $name,
            type         => $type,
            phases       => $phases,
            context      => $ctx,
            options      => $ctx->{build_options}{$name},
            'module-set' => '',
        };

        return bless $module, $class;
    }

    sub phases
    {
        my $self = shift;
        return $self->{phases};
    }

    sub moduleSet
    {
        my ($self) = @_;
        return $self->{'module-set'} if exists $self->{'module-set'};
        return '';
    }

    sub setModuleSet
    {
        my ($self, $moduleSetName) = @_;
        $self->{'module-set'} = $moduleSetName;
    }

    sub setModuleSource
    {
        my ($class, $source) = @_;
        $ModuleSource = $source;
    }

    sub moduleSource
    {
        my $class = shift;
        # Should be 'config' or 'cmdline';
        return $ModuleSource;
    }

    sub name
    {
        my $self = shift;
        return $self->{name};
    }

    # Returns a string describing the scm platform of the given module.
    # Return value: 'git' or 'svn' at this point, as appropriate.
    sub type
    {
        my $self = shift;

        return $self->{type} if $self->{type};

        # Look for specific setting of repository and svn-server. If both is
        # set it's a bug, if one is set, that's the type (because the user says
        # so...). Don't use getOption($key) as it will try to fallback to
        # global options.

        my $svn_status = $self->getOption('svn-server', 'module');
        my $git_status = $self->getOption('repository', 'module');
        my $rcfile = $self->buildContext()->rcFile();

        if ($svn_status && $git_status) {
            error (<<EOF);
You have specified both y[b[svn-server] and y[b[repository] options for the
b[$self] module in $rcfile.

You should only specify one or the other -- a module cannot be both types
 - svn-server uses Subversion.
 - repository uses git.
EOF
            die (make_exception('Config', 'svn-server and repository both set'));
        }

        # If it needs a repo it's git. Everything else is svn for now.
        $self->{type} = $git_status ? 'git' : 'svn';
        return $self->{type};
    }

    sub buildContext
    {
        my $self = shift;
        return $self->{context};
    }

    # Returns the path to the log directory used during this run for this
    # Module.
    #
    # In addition it handles the 'latest' symlink to allow for ease of access
    # to the log directory afterwards.
    sub getLogDir
    {
        my ($self) = @_;
        return $self->buildContext()->getLogDirFor($self);
    }

    sub toString
    {
        my $self = shift;
        return $self->name();
    }

    sub compare
    {
        my ($self, $other) = @_;
        return $self->name() cmp $other->name();
    }

    # This subroutine returns an option value for a given module.  Some globals
    # can't be overridden by a module's choice (but see 2nd parameter below).
    # If so, the module's choice will be ignored, and a warning will be issued.
    #
    # Option names are case-sensitive!
    #
    # Some options (e.g. cmake-options, configure-flags) have the global value
    # and then the module's own value appended together. To get the actual
    # module setting you must use the level limit parameter set to 'module'.
    #
    # Likewise, some qt-copy options do not obey the previous proviso since Qt
    # options are not likely to agree nicely with generic KDE buildsystem
    # options.
    #
    # 1st parameter: Name of option
    # 2nd 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 the
    #     buildContext) NOTE: This overrides global "sticky" options as well!
    sub getOption
    {
        my ($self, $key, $levelLimit) = @_;
        my $ctx = $self->buildContext();
        assert_isa($ctx, 'ksb::BuildContext');
        $levelLimit //= 'allow-inherit';

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

        assert_in($levelLimit, [qw(allow-inherit module)]);

        # If module-only, check that first.
        return $self->{options}{$key} if $levelLimit eq 'module';

        # Some global options always override module options.
        return $ctx->getOption($key) if $ctx->hasStickyOption($key);

        # Some options append to the global (e.g. conf flags)
        my @confFlags = qw(cmake-options configure-flags cxxflags);
        if (list_has(@confFlags, $key) && $ctx->hasOption($key)) {
            return $ctx->getOption($key) . " " . ($self->{options}{$key} || '');
        }

        # Everything else overrides the global option, unless it's simply not
        # set at all.
        return $self->{options}{$key} // $ctx->getOption($key);
    }

    # Returns true if (and only if) the given option key value is set as an
    # option for this module, even if the corresponding value is empty or
    # undefined. In other words it is a way to see if the name of the key is
    # recognized in some fashion.
    #
    # First parameter: Key to lookup.
    # Returns: True if the option is set, false otherwise.
    sub hasOption
    {
        my ($self, $key) = @_;
        my $name = $self->name();

        return exists $self->{options}{$key};
    }

    # Sets the option refered to by the first parameter (a string) to the
    # scalar (e.g. references are OK too) value given as the second paramter.
    sub setOption
    {
        my ($self, %options) = @_;
        while (my ($key, $value) = each %options) {
            # ref($value) checks if value is already a reference (i.e. a hashref)
            # which means we should just copy it over, as all handle_set_env does
            # is convert the string to the right hashref.
            if (!ref($value) && main::handle_set_env($self->{options}, $key, $value))
            {
                return
            }

            debug ("  Setting $self,$key = $value");
            $self->{options}{$key} = $value;
        }
    }

    # Simply removes the given option and its value, if present
    sub deleteOption
    {
        my ($self, $key) = @_;
        delete $self->{options}{$key} if exists $self->{options}{$key};
    }

    # Gets persistent options set for this module. First parameter is the name
    # of the option to lookup. Undef is returned if the option is not set,
    # although even if the option is set, the value returned might be empty.
    # Note that ksb::BuildContext also has this function, with a slightly
    # different signature, which OVERRIDEs this function since Perl does not
    # have parameter-based method overloading.
    sub getPersistentOption
    {
        my ($self, $key) = @_;
        return $self->buildContext()->getPersistentOption($self->name(), $key);
    }

    # Sets a persistent option (i.e. survives between processes) for this module.
    # First parameter is the name of the persistent option.
    # Second parameter is its actual value.
    # See the warning for getPersistentOption above, it also applies for this
    # method vs. ksb::BuildContext::setPersistentOption
    sub setPersistentOption
    {
        my ($self, $key, $value) = @_;
        return $self->buildContext()->setPersistentOption($self->name(), $key, $value);
    }

    # Clones the options from the given Module (as handled by
    # hasOption/setOption/getOption). Options on this module will then be able
    # to be set independently from the other module.
    sub cloneOptionsFrom
    {
        my $self = shift;
        my $other = assert_isa(shift, 'Module');

        $self->{options} = dclone($other->{options});
    }

    # Returns the path to the desired directory type (source or build),
    # including the module destination directory itself.
    sub fullpath
    {
        my ($self, $type) = @_;
        assert_in($type, [qw/build source/]);

        my %pathinfo = main::get_module_path_dir($self, $type);
        return $pathinfo{'fullpath'};
    }

    # Returns true if the module should have make install run in order to be
    # used, or false if installation is not required or possible.
    sub needsInstalled
    {
        my $self = shift;

        return 0 if $self->name() eq 'kde-common'; # Vestigial but possible.

        # Don't install Qt if QTDIR == builddir
        if ($self->name() eq 'qt-copy') {
            return $self->getOption('qtdir') ne $self->fullpath('build');
        }

        return 1;
    }

    1;
}
# }}}

# package RecursiveFH {{{
{
    package RecursiveFH;

    # Alias the global make_exception into this package.
    *make_exception = *main::make_exception;

    sub new
    {
        my ($class) = @_;
        my $data = {
            'filehandles' => [],    # Stack of filehandles to read
            'current'     => undef, # Current filehandle to read
        };

        return bless($data, $class);
    }

    sub addFilehandle
    {
        my ($self, $fh) = @_;
        push @{$self->{filehandles}}, $fh;
        $self->setCurrentFilehandle($fh);
    }

    sub popFilehandle
    {
        my $self = shift;
        my $result = pop @{$self->{filehandles}};
        my $newFh = scalar @{$self->{filehandles}} ? ${$self->{filehandles}}[-1]
                                                   : undef;
        $self->setCurrentFilehandle($newFh);
        return $result;
    }

    sub currentFilehandle
    {
        my $self = shift;
        return $self->{current};
    }

    sub setCurrentFilehandle
    {
        my $self = shift;
        $self->{current} = shift;
    }

    # Reads the next line of input and returns it.
    # If a line of the form "include foo" is read, this function automatically
    # opens the given file and starts reading from it instead. The original
    # file is not read again until the entire included file has been read. This
    # works recursively as necessary.
    #
    # No further modification is performed to returned lines.
    #
    # undef is returned on end-of-file (but only of the initial filehandle, not
    # included files from there)
    sub readLine
    {
        my $self = shift;

        # Starts a loop so we can use evil things like "redo"
        READLINE: {
            my $line;
            my $fh = $self->currentFilehandle();

            # Sanity check since different methods might try to read same file reader
            return undef unless defined $fh;

            if (eof($fh) || !defined($line = <$fh>)) {
                my $oldFh = $self->popFilehandle();
                close $oldFh;

                my $fh = $self->currentFilehandle();

                return undef if !defined($fh);

                redo READLINE;
            }
            elsif ($line =~ /^\s*include\s+\S/) {
                # Include found, extract file name and open file.
                chomp $line;
                my ($filename) = ($line =~ /^\s*include\s+(.+)$/);

                if (!$filename) {
                    die make_exception('Config',
                        "Unable to handle file include on line $., '$line'");
                }

                my $newFh;
                $filename =~ s/^~\//$ENV{HOME}\//; # Tilde-expand

                open ($newFh, '<', $filename) or
                    die make_exception('Config',
                        "Unable to open file $filename which was included from line $.");

                $self->addFilehandle($newFh);

                redo READLINE;
            }
            else {
                return $line;
            }
        }
    }

    1;
}
# }}}

# Global import for debugging routines. This must be a BEGIN block only because
# for a long time I abused the Perl subroutine prototype feature to allow not
# putting parentheses around subs like pretending or info, which would not even
# parse correctly if the customized import routine were not allowed to run
# first and insert prototypes in addition to the method names.
BEGIN {
    ksb::Debug->import();
    ksb::Util->import();
}

# 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 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 = assert_isa(shift, 'Module');
    my $option = shift;
    my $dir = $module->getOption($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 = $module->getOption('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.
# The second parameter is optional, but if provided will be used as the base
#     path to replace $MODULE entries in dest-dir.
sub get_dest_dir
{
    my $module = assert_isa(shift, 'Module');
    my $dest_dir = $module->getOption('dest-dir');
    my $basePath = shift // $module->getOption('#xml-full-path');
    $basePath ||= $module->name(); # Default if not provided in XML

    $dest_dir =~ s/(\${MODULE})|(\$MODULE\b)/$basePath/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 = assert_isa(shift, 'Module');

    my $srcdir = $module->fullpath('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->name() =~ /^l10n-kde4\/?/;

    # No CMakeLists?  Expected for qt-copy
    return 0 if $module->name() 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 = assert_isa(shift, 'Module');
    return get_subdir_path ($module, 'source-dir');
}

# Subroutine to return the branch prefix. i.e. the part before the branch name
# and module name.
#
# The first parameter is the module name 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 $moduleName = 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 $moduleName =~ /^KDE\//;

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

    # KDE extragear / playground modules use this pattern
    return "$type" if has_base_module($moduleName);

    # 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, $moduleName);

    # Everything else.
    return "$type/$moduleName";
}

# 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 = assert_isa(shift, 'Module');
    my $type = shift;
    my $branch = branch_prefix($module->name(), $type);
    my $svn_server = $module->getOption('svn-server');
    my $branchname = $module->getOption($type eq 'branches' ? 'branch' : 'tag');

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

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

    # Remove KDE/ prefix for module name.
    my $moduleName = moduleBaseName($module->name());

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

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

    # 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 = assert_isa(shift, 'Module');
    my $svn_server = $module->getOption('svn-server');
    my $modulePath;

    foreach my $levelLimit ('module', 'allow-inherit') {
        $modulePath = $module->getOption('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($module->getOption('override-url', $levelLimit))
        {
            return $module->getOption('override-url', $levelLimit);
        }

        if($module->getOption('tag', $levelLimit))
        {
            return handle_branch_tag_option($module, 'tags');
        }

        my $branch = $module->getOption('branch', $levelLimit);
        if($branch and $branch ne 'trunk')
        {
            return handle_branch_tag_option($module, 'branches');
        }

        my $moduleName = moduleBaseName($module->name());

        # 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 = $moduleName;
        $module_root =~ s/\/.*//; # Remove everything after the first slash

        if (not $modulePath and $levelLimit eq 'allow-inherit')
        {
            $modulePath = "trunk/KDE/$moduleName";
            $modulePath = "trunk/$moduleName" 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";
}

# 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 = assert_isa(shift, 'Module');

    return get_subdir_path($module, 'build-dir');
}

# 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 = assert_isa(shift, 'Module');
    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 $moduleName = shift;

    return $moduleName =~ /^(extragear|playground|KDE)(\/[^\/]+)?$/;
}

# Moves the directory given by the first parameter to be at the directory given
# by the second parameter, but only if the first exists and the second doesn't.
# The use case is to automatically migrate source and build directories from
# the change in dest-dir handling for XML-based modules.
sub moveOldDirectories
{
    my ($oldDir, $newDir) = @_;
    state $pretendedMoves = { };

    # All this pretended move stuff is just to avoid tons of debug output
    # if run in pretend mode while still showing the message the first time.
    $pretendedMoves->{$oldDir} //= { };
    if (!$pretendedMoves->{$oldDir}->{$newDir} && -e $oldDir && ! -e $newDir) {
        info "\tMoving old kdesrc-build directory at\n\t\tb[$oldDir] to\n\t\tb[$newDir]";

        $pretendedMoves->{$oldDir}->{$newDir} = 1 if pretending;
        safe_system('mv', $oldDir, $newDir) == 0 or
            die "Unable to move directory $oldDir to $newDir";
    }

    return 1;
}

# 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 = assert_isa(shift, 'Module');
    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}";

    my $compatDestDir = get_dest_dir($module, $module->name());
    my $fullCompatPath = "$srcbase/$compatDestDir";

    # kdesrc-build 1.14 changed the source directory layout to be more
    # compatible with the sharply-growing number of modules.
    if ($fullCompatPath ne $combined && -d $fullCompatPath) {
        if ($type eq 'source') {
            super_mkdir($result{'path'});
            moveOldDirectories($fullCompatPath, $combined);
        }
        elsif ($type eq 'build') {
            # CMake doesn't like moving build directories, just destroy the
            # old one.
            state %warnedFor;

            if (!$warnedFor{$fullCompatPath}) {
                $warnedFor{$fullCompatPath} = 1;

                safe_rmtree($fullCompatPath) or do {
                    warning("\tUnable to remove the old build directory for y[b[$module]");
                    warning("\tThe disk layout has changed, you no longer need the old directory at");
                    warning("\t\tb[$fullCompatPath]");
                    warning("\tHowever you will have to delete it, kdesrc-build was unable to.");
                }
            };
        }
    }

    return %result;
}

# 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, but this functionality requires libwww-perl
#
# 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;

    my $ua = LWP::UserAgent->new(timeout => 30);

    # Trailing space adds the appropriate LWP info since the resolver is not
    # my custom coding anymore.
    $ua->agent("kdesrc-build $versionNum ");

    whisper "Downloading g[$filename] from g[$url]";
    my $response = $ua->get($url, ':content_file' => $filename);
    return 1 if $response->is_success;

    error "Failed to download y[b[$url] to b[$filename]";
    error "Result was: y[b[" . $response->status_line . "]";
    return 0;
}

# 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 $moduleName = shift;
    $moduleName =~ s/^KDE\///;

    return $moduleName;
}

# 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 = assert_isa(shift, 'Module');
    my $branch = $module->getOption('branch');

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

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

    my $gitdir = $module->fullpath('source') . '/.git';

    # Note that the --git-dir must come before the git command itself.
    my ($id, undef) = slurp_program_output(
        qw/git --git-dir/, $gitdir, 'rev-parse', $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;
}

# Attempts to download and install a git snapshot for the given Module. This
# requires the module to have the '#snapshot-tarball' option set, normally
# done after KDEXMLReader is used to parse the projects.kde.org XML database.
# This function should be called with the current directory set to the be
# the source directory.
#
# After installing the tarball, an immediate git pull will be run to put the
# module up-to-date. The branch is not updated however!
#
# The user can cause this function to fail by setting the disable-snapshots
# option for the module (either at the command line or in the rc file).
#
# First and only parameter is the Module to install the snapshot for.
#
# Returns boolean true on success, false otherwise.
sub installGitSnapshot
{
    my $module = assert_isa(shift, 'Module');
    my $tarball = $module->getOption('#snapshot-tarball');

    return 0 if $module->getOption('disable-snapshots');
    return 0 unless $tarball;

    if (pretending) {
        pretend "\tWould have downloaded snapshot for g[$module], from";
        pretend "\tb[g[$tarball]";
        return 1;
    }

    info "\tDownloading git snapshot for g[$module]";

    my $filename = basename(URI->new($tarball)->path());
    my $tmpdir = File::Spec->tmpdir() // "/tmp";
    $filename = "$tmpdir/$filename"; # Make absolute

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

    info "\tDownload complete, preparing module source code";

    # It would be possible to use Archive::Tar, but it's apparently fairly
    # slow. In addition we need to use -C and --strip-components (which are
    # also supported in BSD tar, perhaps not Solaris) to ensure it's extracted
    # in a known location. Since we're using "sufficiently good" tar programs
    # we can take advantage of their auto-decompression.
    my $sourceDir = $module->fullpath('source');
    super_mkdir($sourceDir);

    my $result = safe_system(qw(tar --strip-components 1 -C),
                          $sourceDir, '-xf', $filename);
    my $savedError = $!; # Avoid interference from safe_unlink
    safe_unlink ($filename);

    if ($result) {
        error "Unable to extract snapshot for r[b[$module]: $savedError";
        safe_rmtree($sourceDir);
        return 0;
    }

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

    # Complete the preparation by running the initrepo.sh script
    p_chdir($sourceDir);
    $result = log_command($module, 'init-git-repo', ['/bin/sh', './initrepo.sh']);

    if ($result) {
        error "Snapshot for r[$module] extracted successfully, but failed to complete initrepo.sh";
        safe_rmtree($sourceDir);
        return 0;
    }

    info "\tGit snapshot installed, now bringing up to date.";
    $result = log_command($module, 'init-git-pull', ['git', 'pull']);
    return ($result == 0);
}

# 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 = assert_isa(shift, 'Module');
    my $git_repo = shift;
    my $srcdir = $module->fullpath('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->name() eq 'qt-copy';

    note "Cloning g[$module]";

    # Invert the result of installGitSnapshot to get a shell-style return code
    # like those returned by log_command. Likewise the normal || must be a &&
    my $result = (!installGitSnapshot($module)) &&
                 log_command($module, 'git-clone', ['git', 'clone', @args]);

    if ($result == 0) {
        $module->setPersistentOption('git-cloned-repository', $git_repo);

        my $branch = get_git_branch($module);

        # Switch immediately to user-requested branch now.
        if ($branch ne 'master') {
            info "\tSwitching to branch g[$branch]";
            p_chdir($srcdir);
            $result = log_command($module, 'git-checkout',
                ['git', 'checkout', '-b', "origin-$branch", "origin/$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;
    $repoUrl =~ s,^kde:,git://anongit.kde.org/,;
    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

        $url =~ s,^kde:,git://anongit.kde.org/,;
        #info "\tgit_get_best_remote_names($repoUrl) - $remoteName = $url";

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

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

        # A winner is this one.
        #info "\tWinner: $remoteName";
        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 = assert_isa(shift, 'Module');
    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'.
#
# The current directory must be the source directory of the git module.
#
# First 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)
# Second 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 $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 '';
}

# This stashes existing changes if necessary, and then runs git pull --rebase in order
# to advance the given module to the latest head. Finally, if changes were stashed, they
# are applied and the stash stack is popped.
#
# It is assumed that the required remote has been setup already, that we are on the right
# branch, and that we are already in the correct directory.
#
# Returns true on success, false otherwise. Some egregious errors result in
# exceptions being thrown however.
sub git_stash_and_update
{
    my $module = assert_isa(shift, 'Module');
    my $date = strftime ("%F-%R", gmtime()); # ISO Date, hh:mm time

    # To find out if we should stash, we just use git diff --quiet, twice to
    # account for the index and the working dir.
    # Note: Don't use safe_system, as the error code is stripped to the exit code
    my $status = pretending() ? 0 : system('git', 'diff', '--quiet');

    if ($status == -1 || $status & 127) {
        die make_exception('Runtime',
            "$module doesn't appear to be a git module when " .
            "trying to see if there are changes.");
    }

    my $needsStash = 0;
    if ($status) {
        # There is local changes.
        $needsStash = 1;
    }
    else {
        $status = pretending() ? 0 : system('git', 'diff', '--cached', '--quiet');
        if ($status == -1 || $status & 127) {
            die make_exception('Runtime',
                "$module doesn't appear to be a git module when " .
                "trying to see if there are changes.");
        }
        else {
            $needsStash = ($status != 0);
        }
    }

    if ($needsStash) {
        info "\tLocal changes detected, stashing them away...";
        $status = log_command($module, 'git-stash-save', [
                qw(git stash save --quiet), "kdesrc-build auto-stash at $date",
            ]);
        if ($status != 0) {
            die make_exception('Runtime',
                "Unable to stash local changes for $module, aborting update.");
        }
    }

    $status = log_command($module, 'git-pull-rebase', [
            qw(git pull --rebase --quiet)
        ]);

    if ($status != 0) {
        error "Unable to update the source code for r[b[$module]";
        return 0;
    }

    # Update is performed and successful, re-apply the stashed changes
    if ($needsStash) {
        info "\tModule updated, reapplying your local changes.";
        $status = log_command($module, 'git-stash-pop', [
                qw(git stash pop --index --quiet)
            ]);
        if ($status != 0) {
            error <<EOF;
 r[b[*]
 r[b[*] Unable to re-apply stashed changes to r[b[$module]!
 r[b[*]
 * These changes were saved using the name "kdesrc-build auto-stash at $date"
 * and should still be available using the name stash\@{0}, the command run
 * to re-apply was y[git stash --pop --index]. Resolve this before you run
 * kdesrc-build to update this module again.
 *
 * If you do not desire to keep your local changes, then you can generally run
 * r[b[git reset --hard HEAD], or simply delete the source directory for
 * $module. Developers be careful, doing either of these options will remove
 * any of your local work.
EOF
            return 0;
        }
    }

    return 1;
}

# 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.
# Return parameter is the number of affected *commits*. Errors are
# returned only via exceptions because of this.
sub git_update_module
{
    my $module = assert_isa(shift, 'Module');
    my $srcdir = $module->fullpath('source');
    my $old_repo = $module->getPersistentOption('git-cloned-repository');
    my $cur_repo = $module->getOption('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($module);

    # 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.
        $module->setPersistentOption('git-cloned-repository', $cur_repo);
    }

    # Download updated objects
    # This also updates remote heads so do this before we start comparing branches
    # and such, even though we will later use git pull.
    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(\@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";
        }
    }

    # With all remote branches fetched, and the checkout of our desired branch
    # completed, we can now use git pull to complete the changes.
    if (git_stash_and_update($module)) {
        my $end_commit = git_commit_id($module);
        return count_command_output('git', 'rev-list', "$start_commit..$end_commit");
    }
    else {
        # We must throw an exception if we fail.
        die "Unable to update $module";
    }
}

# 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 = assert_isa(shift, 'Module');
    my $srcdir = $module->fullpath('source');

    if (-d "$srcdir/.git") {
        # Note that this function will throw an exception on failure.
        return git_update_module($module);
    }
    else {
        # Check if an existing source directory is there somehow.
        if (-e "$srcdir") {
            if ($module->getOption('#delete-my-patches')) {
                warning "\tRemoving conflicting source directory ",
                        "as allowed by --delete-my-patches";
                warning "\tRemoving b[$srcdir]";
                safe_rmtree($srcdir) or do {
                    die "Unable to delete r[b[$srcdir]!";
                };
            }
            else {
                error <<EOF;
The source directory for b[$module] does not exist. kdesrc-build would download
it, except there is already a file or directory present in the desired source
directory:
\ty[b[$srcdir]

Please either remove the source directory yourself and re-run this script, or
pass the b[--delete-my-patches] option to kdesrc-build and kdesrc-build will
try to do so for you.

DO NOT FORGET TO VERIFY THERE ARE NO UNCOMMITTED CHANGES OR OTHER VALUABLE
FILES IN THE DIRECTORY.

EOF

                if (-e "$srcdir/.svn") {
                    error "svn status of $srcdir:";
                    system('svn', 'st', '--non-interactive', $srcdir);
                }

                die ('Conflicting source-dir present');
            }
        }

        my $git_repo = $module->getOption('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) = @_;
    assert_isa($module, 'Module');
    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'});

    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) = @_;
    assert_isa($module, 'Module');
    my $fullpath = $module->fullpath('source');
    my @args;

    p_chdir ($fullpath);

    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 module object 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) = @_;
    assert_isa($module, 'Module');
    my $pid;
    my @command = @{$argRef};
    my $logdir = $module->getLogDir();

    debug "log_command(): Module $module, Command: ", join(' ', @command);

    # 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
            {
                chomp $_;
                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

        # Avoid calling close subroutines in more than one routine.
        @main::atexit_subs = ();

        # Apply altered environment variables.
        while (my ($key, $value) = each %ENV_VARS) {
            $ENV{$key} = $value;
            debug "\tSetting environment variable g[$key] to g[b[$value]";
        }

        if (pretending)
        {
            pretend "\tWould have run g['", join ("' '", @command), "'";
            exit 0;
        }

        if (not $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{'KDESRC_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 qt-copy, we forced on progress output so let's leave
        # that interactive to keep the logs sane.
        if($command[0] ne 'svn' && $module->name() ne 'qt-copy') {
            open (STDERR, ">&STDOUT");
        }

        # Call internal function, name given by $command[1]
        if($command[0] eq 'kdesrc-build')
        {
            # No colors!
            ksb::Debug::setColorfulOutput(0);
            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 (! &{$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 = assert_isa(shift, 'Module');
    my $logfile = shift;

    return unless $logfile;

    my $logdir = $module->getLogDir();

    $module->setOption('#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 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) = @_;
    assert_isa($module, 'Module');

    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) = @_;
    assert_isa($module, 'Module');

    return 0 if ($dir eq 'scripts' && ($module->name() =~ '^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 (which itself must be a Module object, not merely the name).
#
# Returns 0 on success, non-zero on failure (shell script style)
sub safe_make (@)
{
    my ($module, @args) = @_;
    assert_isa($module, 'Module');

    my $logdir = $module->getLogDir();
    my $checkout_dirs = $module->getOption("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 = $module->getOption('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(' ', $module->getOption('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 = $module->fullpath('build') . "/$subdir";
        $builddir =~ s/\/*$//; # Remove trailing /

        p_chdir ($builddir);

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

    return 0;
}

# 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.
sub default_module_options
{
    my $moduleName = shift;
    my %options = (
        'set-env' => { },
    );
    my %module_options = (
        'qt-copy' => {
            'configure-flags' => '-no-phonon -dbus -nomake demos -nomake examples -fast',
            'repository' => 'git://anongit.kde.org/qt',
            'branch'     => '4.8',
        },
        'strigi' => {
            # Until the strigi build system supports independent submodule
            # builds.
            'cmake-options' => '-DSTRIGI_SYNC_SUBMODULES=TRUE',
            'reconfigure'   => 'true',
        },
        'taglib' => {
            'cmake-options' => '-DWITH_ASF=TRUE -DWITH_MP4=TRUE',
        },
        'dbusmenu-qt' => {
            'repository' => 'git://gitorious.org/dbusmenu/dbusmenu-qt.git',
        },
    );

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

    # Otherwise merge in options (uses Perl hash slice)
    my $this_module_options = $module_options{$moduleName};
    @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 "\tMarking g[$var] to be set to y[$val].";

    $ENV_VARS{$var} = $val;
}

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

# 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 readNextLogicalLine
{
    my $fileReader = shift;

    while($_ = $fileReader->readLine()) {
        # Remove trailing newline
        chomp;

        # Replace \ followed by optional space at EOL and try again.
        if(s/\\\s*$//)
        {
            $_ .= $fileReader->readLine();
            redo;
        }

        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 $ctx = assert_isa(shift, 'ksb::BuildContext');
    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 = $ctx->getOption($sub_var_name) || '';
        if(!$ctx->hasOption($sub_var_value)) {
            warning " *\n * WARNING: $sub_var_name is not set at line y[$.]\n *";
        }

        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 ($ctx, $fileReader, $moduleName) = @_;
    assert_isa($ctx, 'ksb::BuildContext');

    my $rcfile = $ctx->rcFile();
    my $module = $moduleName eq 'global' ? $ctx : Module->new($ctx, $moduleName);
    my $endWord = $moduleName eq 'global' ? 'global' : 'module';
    my $endRE = qr/^end\s+$endWord/;

    # Read in each option
    while ($_ = readNextLogicalLine($fileReader))
    {
        last if m/$endRE/;

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

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

        # Handle special options.
        if ($moduleName 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 = $ctx->getOption($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 y[b[kde] g[b[git://anongit.kde.org/]

Use this in a "module-set" group:

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

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

        $module->setOption($option, $value);
    }

    return $module;
}

# Tries to download the kde_projects.xml file needed to make XML module support
# work. Only tries once per script run. If it does succeed, the result is saved
# to $srcdir/kde_projects.xml
#
# Returns 0 if the file could not be downloaded, 1 otherwise.
sub ensure_projects_xml_present
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $srcdir = get_source_dir($ctx);
    my $file = "$srcdir/kde_projects.xml";
    state $cachedSuccess;

    # See if we've already tried to download. If we ever try to download for
    # real, we end up unlinking the file if it didn't successfully complete the
    # download, so we shouldn't have to worry about a corrupt XML file hanging
    # out for all time.
    if (defined $cachedSuccess && !$cachedSuccess) {
        die make_exception('Internal', "Attempted to find projects.xml after it already failed");
    }

    return 1 if $cachedSuccess;

    # Not previously attempted, let's make a try.
    super_mkdir($srcdir) unless -d "$srcdir";
    my $url = "http://projects.kde.org/kde_projects.xml";

    my $result = 1;
    if (!pretending) {
        info " * Downloading projects.kde.org project database...";
        $result = download_file($url, $file);
    }
    elsif (! -e $file) {
        note " y[*] b[ACTUALLY downloading projects.kde.org project database to make the rest]";
        note " y[*] b[of the --pretend output make sense.]";
        $result = download_file($url, $file);
    }
    else {
        info " * y[Using existing projects.kde.org project database], output may change";
        info " * when database is updated next.";
    }

    $cachedSuccess = $result;

    if (!$result) {
        unlink $file if -e $file;
        die make_exception('Runtime', "Unable to download kde_projects.xml for the kde-projects repository!");
    }

    return $result;
}

# 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 $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $fileReader = shift;
    my $moduleSetName = shift || '';
    my $repoSet = $ctx->getOption('git-repository-base');
    my $rcfile = $ctx->rcFile();
    my @modules;
    my %optionSet; # We read all options, and apply them to all modules
    my $startLine = $.; # For later error messages

    while($_ = readNextLogicalLine($fileReader)) {
        last if /^end\s+module(-?set)?$/;

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

        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');
            }
        }
        elsif ($option eq 'set-env') {
            handle_set_env(\%optionSet, $option, $value);
        }
        else {
            $optionSet{$option} = $value;
        }
    }

    # Check before we start looping whether the user did something silly.
    if (exists $optionSet{'repository'} &&
        ($optionSet{'repository'} ne KDE_PROJECT_ID) &&
        not exists $repoSet->{$optionSet{'repository'}})
    {
        my $projectID = KDE_PROJECT_ID;
        my $moduleSetId = "module-set";
        $moduleSetId = "module-set ($moduleSetName)" if $moduleSetName;

        error <<EOF;
There is no repository assigned to y[b[$optionSet{repository}] when assigning a
$moduleSetId 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!

If you are trying to pull the module information from the KDE
http://projects.kde.org/ website, please use b[$projectID] for the value of
the b[repository] option.
EOF

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

    my @moduleList; # module names converted to Module objects.
    my $selectedRepo;
    my $usingXML = (exists $optionSet{'repository'}) &&
                    $optionSet{'repository'} eq KDE_PROJECT_ID;

    # Setup default options for each module
    # Extraction of relevant XML modules will be handled immediately after
    # this phase of execution.
    for my $module (@modules) {
        my $moduleName = $module;
        my $moduleType;

        # Remove trailing .git for module name
        $moduleName =~ s/\.git$// unless $usingXML;

        $moduleType = 'proj' if $usingXML;

        my $newModule = Module->new($ctx, $moduleName, $moduleType);
        $newModule->setModuleSet($moduleSetName);
        push @moduleList, $newModule;

        # Dump all options into the existing Module's options.
        $newModule->setOption(%optionSet);

        # Fixup for the special repository handling if need be.
        if (!$usingXML && exists $optionSet{'repository'}) {
            $selectedRepo = $repoSet->{$optionSet{'repository'}} unless $selectedRepo;
            $newModule->setOption('repository', $selectedRepo . $moduleName);
        }
    }

    if (not scalar @moduleList) {
        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.";
    }

    return @moduleList;
}

# Goes through the provided modules that have the 'proj' type (i.e. XML
# projects.kde.org database) and expands the proj-types into their equivalent
# git modules, and returns the fully expanded list. Non-proj modules are
# included in the sequence they were originally.
sub expandXMLModules
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my @modules = @_;

    # Using a sub allows me to use the 'return' keyword.
    my $filter = sub {
        my $moduleSet = shift;

        # Only attempt to expand out XML-based modules.
        return $moduleSet if $moduleSet->type() ne 'proj';

        ensure_projects_xml_present($ctx) or
            die "kde-projects repository information could not be downloaded: $!.";

        my $name = $moduleSet->name();
        my $srcdir = get_source_dir($ctx);

        # It's possible to match modules which are marked as inactive on
        # projects.kde.org, elide those.
        my @xmlResults = grep {
            $_->{'active'} ne 'false'
        } (KDEXMLReader->getModulesForProject($name, $srcdir));

        if (!@xmlResults) {
            warning " y[b[*] Module y[$name] is apparently XML-based, but contains no\n",
                "active modules to build!";
            my $count = KDEXMLReader->getModulesForProject($name, $srcdir);
            if ($count > 0) {
                warning "\tAlthough no active modules are available, there were\n",
                    "\t$count inactive modules. Perhaps the git modules are not ready?";
            }
        }

        # Setup module options. This alters the results in @xmlResults.
        foreach (@xmlResults) {
            my $result = $_;

            # This alters the item we were looking at.
            $_ = Module->new($ctx, $result->{'name'}, 'git');
            $_->cloneOptionsFrom($moduleSet);
            $_->setOption('repository', $result->{'repo'});
            $_->setOption('#xml-full-path', $result->{'fullName'});

            my $tarball = $result->{'tarball'};
            $_->setOption('#snapshot-tarball', $tarball) if $tarball;
        };

        return @xmlResults;
    };

    return map { &$filter($_) } (@modules);
}

# This subroutine takes a reference to the current module list (specifically a
# list of Module objects), and takes a reference to the list of Module objects
# read in from the config file.
#
# For each module in the first list, it is checked to see if options have been
# read in for it, and if so it is left alone.
#
# If the module does not have any options for it, it is assumed that the user
# might mean a named module set (i.e. the module is the name of a module-set),
# and /if/ any of the Modules in the second list are recorded as having come
# from a module set matching the name of the current module, it is used
# instead.
#
# The processed module list is the return value.
sub expandModuleSets
{
    my ($buildModuleList, $knownModules) = @_;

    my $filter = sub {
        my $setName = $_->name();

        # If the module name matches a read-in Module, then it's not a set.
        return $_ if grep { $setName eq $_->name() } (@$knownModules);

        # XML module can only happen if forced by user on command line, allow
        # it.
        return $_ if $_->type() eq 'proj';

        # Otherwise assume it's a set, replace this with all sub-modules in that
        # module set.
        my @modulesInSet = grep { $_->moduleSet() eq $setName } (@$knownModules);

        if (!@modulesInSet) {
            die make_exception('Runtime', "Unknown module or module-set: $setName");
        }

        return @modulesInSet;
    };

    return map { &$filter } (@$buildModuleList);
}

# This subroutine reads in the settings from the user's configuration
# file. The filehandle to read from should be passed in as the first
# parameter. The filehandle should be something that the <> operator works
# on, usually some subclass of IO::Handle.
sub read_options
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $fh = shift;
    my @module_list;
    my $rcfile = $ctx->rcFile();
    my ($option, $modulename, %readModules);

    my $fileReader = RecursiveFH->new();
    $fileReader->addFilehandle($fh);

    # Read in global settings
    while ($_ = $fileReader->readLine())
    {
        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($ctx, $fileReader, 'global');
        last;
    }

    my $using_default = 1;

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

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

        if (not $modulename)
        {
            my $moduleSetRE = qr/^module-set\s*([-\/\.\w]+)?\s*$/;
            ($modulename) = m/$moduleSetRE/;

            # modulename may be blank -- use the regex directly to match
            if (not /$moduleSetRE/) {
                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.
            push @module_list, parse_moduleset($ctx, $fileReader, $modulename);
        }
        else {
            push @module_list, parse_module($ctx, $fileReader, $modulename);
        }

        # Don't build default modules if user has their own wishes.
        $using_default = 0;
    }

    # 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 updateModulePhases.
    @module_list = grep {
        not exists $ignore_list{$_->name()}
    } (@module_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.
    if ($using_default) {
        $ctx->setup_default_modules();
        return ();
    }

    return @module_list;
}

# 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 = assert_isa(shift, 'Module');

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

# 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 = assert_isa(shift, 'Module');
    my ($key, $value);

    # Let's see if the user has set env vars to be set.
    my $env_hash_ref = $module->getOption('set-env');
    while (($key, $value) = each %{$env_hash_ref})
    {
        setenv($key, $value);
    }
}

# 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 ($ctx, $message, @fail_list) = @_;
    assert_isa($ctx, 'ksb::BuildContext');

    $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 my $module (@fail_list)
        {
            $logfile = $module->getOption('#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 = $module->getLogDir() . "/error.log";
                $logfile = $logdir if -e $logdir;
            }

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

            warning "r[$module]" if pretending;
            warning "r[$module] - 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
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');

    # This list should correspond to the possible phase names (although
    # it doesn't yet since the old code didn't, TODO)
    for my $phase ($ctx->phases()->phases())
    {
        my @failures = $ctx->failedModulesInPhase($phase);
        output_failed_module_list($ctx, "failed to $phase", @failures);
    }

    # See if any modules fail continuously and warn specifically for them.
    my @super_fail = grep {
        ($_->getPersistentOption('failure-count') // 0) > 3
    } (@{$ctx->moduleList()});

    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} //= { };
    ${$href}{$option}->{$var} = join(' ', @values);

    return 1;
}

# 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 = assert_isa(shift, 'Module');
    my $param = shift;
    my $srcdir = $module->fullpath('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_svn_revision
{
    my $module = assert_isa(shift, 'Module');

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

# Returns a string containing the current on-disk revision identifier, or
# undef if there was an error, for any of the support module scm types.
#
# First parameter is the name of the module to examine.
sub current_module_revision
{
    my $module = assert_isa(shift, 'Module');

    if ($module->type() eq 'svn') {
        return current_module_svn_revision($module);
    }
    elsif ($module->type() eq 'git') {
        return git_commit_id($module);
    }

    return undef;
}

# Subroutine to process the command line arguments, which should be passed as
# a list. The list of module names passed on the command line will be returned,
# In addition, a second parameter should be passed, a reference to a hash that
# will hold options that cannot be set until the rc-file is read.
#
# NOTE: One exception to the return value is that if --run is passed, the list
# of options to pass to the new program is returned instead (you can tell by
# evaluating the '#start-program' option.
# NOTE: Don't call finish() from this routine, the lock hasn't been obtained.
sub process_arguments
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $pendingOptions = shift;
    my $phases = $ctx->phases();
    my @savedOptions = @_; # Used for --debug
    my @options = @_;
    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 @enteredModules;

    while ($_ = shift @options)
    {
        SWITCH: {
            /^(--version)$/      && do { print "$version\n"; exit; };
            /^--author$/         && do { print $author; exit; };
            /^(-h)|(--?help)$/   && do {
                print <<DONE;
$version
http://kdesrc-build.kde.org/

This script automates the download, build, and install process for KDE software
using the latest available source code.

You should first setup a configuration file (~/.kdesrc-buildrc). You can do
this by running the kdesrc-build-setup program, which should be included with
this one.  You can also copy the kdesrc-buildrc-sample file (which should be
included) to ~/.kdesrc-buildrc.

Basic synopsis, after setting up .kdesrc-buildrc:
\$ $0 [--options] [module names]

The module names can be either the name of an individual module (as set in your
configuration with a module declaration, or a use-modules declaration), or of a
module set (as set with a module-set declaration).

If you don\'t specify any particular module names, then every module you have
listed in your configuration will be built, in the order listed.

Copyright (c) 2003 - 2011 $author
The script is distributed under the terms of the GNU General Public License
v2, and includes ABSOLUTELY NO WARRANTY!!!

Options:
    --no-src             Skip contacting the source server.
    --no-build           Skip the build process.
    --no-install         Don't automatically install after build.

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

    --rc-file=<filename> Read configuration from filename instead of default.

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

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

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

    --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.
    --refresh-build      Start the build from scratch.

    --help               You\'re reading it. :-)
    --version            Output the program version.

You can get more help by going online to http://kdesrc-build.kde.org/ to view
the online documentation.  If you have installed kdesrc-build you may also be
able to view the documentation using KHelpCenter or Konqueror at the URL
help:/kdesrc-build
DONE
                # We haven't done any locking... no need to finish()
                exit 0;
            };

            /^--install$/ && do {
                $run_mode = 'install';
                $phases->phases('install');

                last SWITCH;
            };

            /^--uninstall$/ && do {
                $run_mode = 'uninstall';
                $phases->phases('uninstall');

                last SWITCH;
            };

            /^--no-snapshots$/ && do {
                $ctx->setOption('#disable-snapshots', 1);
                last SWITCH;
            };

            /^--no-(src|svn)$/ && do {
                $phases->filterOutPhase('update');
                last SWITCH;
            };

            /^--no-install$/ && do {
                $phases->filterOutPhase('install');
                last SWITCH;
            };

            /^--no-tests$/ && do {
                # The "right thing" to do
                $phases->filterOutPhase('test');

                # What actually works at this point.
                $ctx->setOption('#run-tests', 0);
                last SWITCH;
            };

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

            /^(-v)|(--verbose)$/ && do {
                $ctx->setOption('#debug-level', ksb::Debug::WHISPER);
                last SWITCH;
            };

            /^(-q)|(--quiet)$/ && do {
                $ctx->setOption('#debug-level', ksb::Debug::NOTE);
                last SWITCH;
            };

            /^--really-quiet$/ && do {
                $ctx->setOption('#debug-level', ksb::Debug::WARNING);
                last SWITCH;
            };

            /^--debug$/ && do {
                $ctx->setOption('#debug-level', ksb::Debug::DEBUG);
                debug "Commandline was: ", join(', ', @savedOptions);
                last SWITCH;
            };

            /^--reconfigure$/ && do {
                $ctx->setOption('#reconfigure', 1);
                last SWITCH;
            };

            /^--color$/ && do {
                $ctx->setOption('#colorful-output', 1);
                last SWITCH;
            };

            /^--no-color$/ && do {
                $ctx->setOption('#colorful-output', 0);
                last SWITCH;
            };

            /^--no-build$/ && do {
                $phases->filterOutPhase('build');
                last SWITCH;
            };

            /^--async$/ && do {
                $ctx->setOption('#async', 1);
                last SWITCH;
            };

            /^--no-async$/ && do {
                $ctx->setOption('#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
                $phases->phases('update');

                # We have an auto-switching function that we only want to run
                # if --src-only was passed to the command line, so we still
                # need to set a flag for it.
                $ctx->setOption('#allow-auto-repo-move', 1);
                last SWITCH;
            };

            # Don't run source updates or install
            /^--build-only$/ && do {
                $phases->phases('build');
                last SWITCH;
            };

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

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

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

            /^--rc-file=?/ && do {
                my $rcfile = extract_option_value_required($_, @options);
                $ctx->setRcFile($rcfile);

                last SWITCH;
            };

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

                $ctx->setOption('#kdedir', $prefix);
                $ctx->setOption('#reconfigure', 1);

                last SWITCH;
            };

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

                $ctx->setOption('#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 @options = () statement;
                my @innerOptions = ();
                foreach (@options)
                {
                    if (/^-/)
                    {
                        push @innerOptions, $_;
                    }
                    else
                    {
                        $ignore_list{$_} = 1;

                        # the pattern match doesn't work with $_, alias it.
                        my $module = $_;
                        @enteredModules = grep (!/^$module$/, @enteredModules);
                    }
                }
                @options = @innerOptions;

                last SWITCH;
            };

            /^(--dry-run)|(--pretend)|(-p)$/ && do {
                $ctx->setOption('#pretend', 1);
                # Simulate the build process too.
                $ctx->setOption('#build-when-unchanged', 1);
                last SWITCH;
            };

            /^--refresh-build$/ && do {
                $ctx->setOption('#refresh-build', 1);
                last SWITCH;
            };

            /^--delete-my-patches$/ && do {
                $ctx->setOption('#delete-my-patches', 1);
                last SWITCH;
            };

            /^(--revision|-r)=?/ && do {
                my $revision = extract_option_value_required($_, @options);
                $ctx->setOption('#revision', $revision);

                last SWITCH;
            };

            /^--resume-from=?/ && do {
                $_ = extract_option_value_required($_, @options);
                $ctx->setOption('#resume-from', $_);

                last SWITCH;
            };

            /^--resume-after=?/ && do {
                $_ = extract_option_value_required($_, @options);
                $ctx->setOption('#resume-after', $_);

                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($_, @options);

                if ($ctx->hasOption($option))
                {
                    $ctx->setOption("#$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;
                    }

                    ${$pendingOptions}{$module}{"$option"} = $value;
                }

                last SWITCH;
            };

            /^-/ && do { print "WARNING: Unknown option $_\n"; last SWITCH; };

            # Strip trailing slashes.
            s/\/*$//;
            push @enteredModules, $_; # Reconstruct correct @options
        }
    }

    # Don't go async if only performing one phase.  It (should) work but why
    # risk it?
    if (scalar $phases->phases() == 1)
    {
        $ctx->setOption('#async', 0);
    }

    return map { Module->new($ctx, $_) } (@enteredModules);
}

# 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 $ctx = assert_isa(shift, 'ksb::BuildContext');
    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(sub {
        note "Signal received, terminating.";
        @main::atexit_subs = (); # Remove their finish, doin' it manually
        finish($ctx, 5);
    });

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

sub updateModulePhases
{
    whisper "Filtering out module phases.";
    for my $module (@_) {
        if ($module->getOption('manual-update') ||
            $module->getOption('no-svn') || $module->getOption('no-src'))
        {
            $module->phases()->clear();
            next;
        }

        if ($module->getOption('manual-build')) {
            $module->phases()->filterOutPhase('build');
            $module->phases()->filterOutPhase('test');
            $module->phases()->filterOutPhase('install');
        }

        $module->phases()->filterOutPhase('install') unless $module->getOption('install-after-build');
        $module->phases()->addPhase('test') if $module->getOption('run-tests');
    }

    return @_;
}

# 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.
# Throws an exception on failure. See File::Path.
sub super_mkdir
{
    my $pathname = shift;
    state %createdPaths;

    if (pretending) {
        if (!exists $createdPaths{$pathname} && ! -e $pathname) {
            pretend "\tWould have created g[$pathname]";
        }

        $createdPaths{$pathname} = 1;
        return 1;
    }
    else {
        make_path($pathname);
        return (-e $pathname) ? 1 : 0;
    }
}

# 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 = assert_isa(shift, 'Module');
    my $ctx = assert_isa($module->buildContext(), 'ksb::BuildContext');
    my $ipc = shift;
    my $reason = shift;

    whisper "Not building $module";

    if ($ipc)
    {
        $ipc->sendIPCMessage($reason, $module->name());
    }
    else
    {
        # Weed out matches of the module name
        $module->phases()->filterOutPhase('build');

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

    if ($reason != IPC::MODULE_UPTODATE)
    {
        $ctx->markModulePhaseFailed('update', $module);
    }
}

# Subroutine to split a url into a protocol and host
sub split_url
{
    my $url = shift;
    my ($proto, $host) = ($url =~ m|([^:]*)://([^/]*)/|);

    return ($proto, $host);
}

# This subroutine checks if we are supposed to use ssh agent by examining the
# environment, and if so checks if ssh-agent has a list of identities.  If it
# doesn't, we run ssh-add (with no arguments) and inform the user.  This can
# be controlled with the disable-agent-check parameter.
sub check_for_ssh_agent
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');

    # Don't bother with all this if the user isn't even using SSH.
    return 1 if pretending;

    my @svnServers = grep {
        $_->type() eq 'svn'
    } ($ctx->modulesInPhase('update'));

    my @gitServers = grep {
        $_->type() eq 'git'
    } ($ctx->modulesInPhase('update'));

    my @sshServers = grep {
        my ($proto, $host) = split_url($_->getOption('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 = $_->getOption('repository');
        ($repo =~ /^git\+ssh:\/\//) || ($repo =~ /^[a-zA-Z0-9_.]+@.*:\//);
    } @gitServers;

    whisper "\tChecking for SSH Agent" if (scalar @sshServers);
    return 1 if (not @sshServers) or $ctx->getOption('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
        {
            my $rcfile = $ctx->rcFile();

            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 add the 'kde:' alias to the user's git config if it's not
# already set.
sub verifyGitConfig
{
    my $configOutput = `git config --global --get url.git://anongit.kde.org/.insteadOf kde: 2>/dev/null`;

    # 0 means no error, 1 means no such section exists -- which is OK
    if ((my $errNum = $? >> 8) >= 2) {
        my $error = "Code $errNum";
        my %errors = (
            3   => 'Invalid config file (~/.gitconfig)',
            4   => 'Could not write to ~/.gitconfig',
            128 => 'HOME environment variable is not set (?)',
        );

        $error = $errors{$errNum} if exists $errors{$errNum};
        error " r[*] Unable to run b[git] command:\n\t$error";
        return 0;
    }

    # If we make it here, I'm just going to assume git works from here on out
    # on this simple task.
    if ($configOutput !~ /^kde:\s*$/) {
        info "\tAdding git download kde: alias";
        my $result = safe_system(
            qw(git config --global --add url.git://anongit.kde.org/.insteadOf kde:)
        ) >> 8;
        return 0 if $result != 0;
    }

    $configOutput = `git config --global --get url.git\@git.kde.org:.pushInsteadOf kde: 2>/dev/null`;

    if ($configOutput !~ /^kde:\s*$/) {
        info "\tAdding git upload kde: alias";
        my $result = safe_system(
            qw(git config --global --add url.git@git.kde.org:.pushInsteadOf kde:)
        ) >> 8;
        return 0 if $result != 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 second parameter should be the build context (ksb::BuildContext)
# for this run.
#
# 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 $ctx's update phase to $ipc before returning.
#
# Returns 0 on success, non-zero on error.
sub handle_updates
{
    my ($ipc, $ctx) = @_;
    my $kdesrc = get_source_dir($ctx);
    my $hadError = 0;
    my @update_list = $ctx->modulesInPhase('update');

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

    if (not check_for_ssh_agent($ctx))
    {
        $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() && !$ctx->getOption('#debug-level'))
    {
        $ctx->setOption('#debug-level', ksb::Debug::WARNING);
    }

    if (grep { $_->type() eq 'git' } @update_list) {
        verifyGitConfig();
    }

    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 { $_->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)
    {
        my $moduleName = $module->name();
        $moduleName = $l10n if $moduleName eq 'l10n'; # Correct internal name.

        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]: $module_src_dir";
                $ipc->sendIPCMessage(IPC::MODULE_FAILURE, $moduleName);
                next;
            }
        }

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

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

        # Ensure that scripts is pulled in for the update process (not req'd
        # for build or install) for l10n module.
        push @options, 'scripts' if ($moduleName eq $l10n);

        my $fullpath = $module->fullpath('source');
        my $count;

        eval {
            if ($module->type() 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 ($@)
        {
            if (ref $@ && $@->isa('BuildException')) {
                $@ = $@->{'message'};
            }

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

            my $reason = $module->getOption('#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].";
                $ipc->notifyUpdateSuccess($moduleName, $message);
            }
            elsif ($count)
            {
                $message = "1 file affected." if $count == 1;
                $message = "$count files affected." if $count != 1;
                $ipc->notifyUpdateSuccess($moduleName, $message);
            }
            else
            {
                whisper "This module will not be built. Nothing updated.";
                $message = "0 files affected.";
                dont_build($module, $ipc, IPC::MODULE_UPTODATE); # Sends IPC message.
            }

            # We doing e.g. --src-only, the build phase that normally outputs
            # number of files updated doesn't get run, so manually mention it
            # here.
            if (!$ipc->supportsConcurrency()) {
                info "\t$module update complete, $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 = assert_isa(shift, 'Module');
    my $srcdir = $module->fullpath('source');
    my $script = "$srcdir/configure";

    # This is only currently run for qt-copy, so let's verify that.
    if ($module->name() 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 @commands = split (/\s+/, $module->getOption('configure-flags'));
    push @commands, '-confirm-license', '-opensource';

    # Get the user's CXXFLAGS
    my $cxxflags = $module->getOption('cxxflags');
    setenv ('CXXFLAGS', $cxxflags);

    my $prefix = $module->getOption('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 use a special script for qt-copy to auto-accept the license, it is created
    # just before running it (see below).
    my $builddir = $module->fullpath('build');
    my $old_flags = $module->getPersistentOption('last-configure-flags') || '';

    unshift @commands, $script;

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

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

        $module->setPersistentOption('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 = assert_isa(shift, 'Module');
    my $srcdir = $module->fullpath('source');
    my @commands = split_quoted_on_whitespace ($module->getOption('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(' ', $module->getOption('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 = $module->getOption('cxxflags');
    if ($cxxflags and not grep { /^-DCMAKE_CXX_FLAGS(:\w+)?=/ } @commands)
    {
        push @commands, "-DCMAKE_CXX_FLAGS:STRING=$cxxflags";
    }

    my $prefix = $module->getOption('prefix');

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

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

    if ($module->getOption('run-tests') &&
        !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 ($module->getOption('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->name() =~ /^l10n-kde4\/?/)
    {
        $srcdir = ".";
    }

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

    my $old_options =
        $module->getPersistentOption('last-cmake-options') || '';
    my $builddir = $module->fullpath('build');

    if (($old_options ne get_list_digest(@commands)) ||
        $module->getOption('reconfigure') ||
        ! -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";

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

    # Skip cmake run
    return 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 = assert_isa(shift, 'Module');
    my $builddir = $module->fullpath('build');
    my $srcdir = $module->fullpath('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 = assert_isa(shift, 'Module');
    my $srcdir = $module->fullpath('source');
    my $builddir = $module->fullpath('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->name() =~ /^l10n-kde4\/?/; # Done.
    }

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

    # Verify we're building what we expect.
    if ($module->name() !~ /^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->name() =~ /^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 = assert_isa(shift, 'Module');
    my $builddir = $module->fullpath('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 $module->getOption('refresh-build');
        debug "Can't find configure key file for $module." if not -e "$builddir/$conf_file_key";
        debug "l10n always needs autogen.sh run" if $module->name() =~ /^l10n-kde4/;
    }

    return 1 if ((not -e "$builddir") ||
        (-e "$builddir/.refresh-me") ||
        $module->getOption("refresh-build") ||
        $module->name() =~ /^l10n-kde4/ ||
        (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 object 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) = @_;
    assert_isa($module, 'Module');
    my $conflict = 0;

    my $revision = $module->getOption('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 = $module->getLogDir();
    $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.
        $module->setOption('#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";
    eval {
        remove_tree($dir, { keep_root => 1 });
    };

    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 = assert_isa(shift, 'Module');
    my $moduledir = $module->fullpath('source');
    my $builddir = $module->fullpath('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 = assert_isa(shift, 'Module');
    my $moduleName = $module->name();
    my $srcdir = $module->fullpath('source');
    my $builddir = $module->fullpath('build');

    if (needs_refreshed($module))
    {
        # The build system needs created, either because it doesn't exist, or
        # because the user has asked that it be completely rebuilt.
        info "\tPreparing build system for y[$module].";

        # Check to see if we're actually supposed to go through the cleaning
        # process.
        if (not $module->getOption('#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 (!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 ($moduleName =~ /^l10n-kde4\/?/)
    {
        if (safe_create_build_system ($module))
        {
            error "\tUnable to create configure system from checkout.";
            return 0;
        }

        $module->setOption('#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 (!module_uses_cmake($module))
    {
        if (! -e "$srcdir/configure")
        {
            error "\tUnknown build system for y[$module] (is it supposed to be built at all?)";
            return 0;
        }

        # 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_VARS{$envName} // $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 = assert_isa(shift, 'Module');
    my $kdedir = $module->getOption('kdedir');
    my $qtdir = $module->getOption('qtdir');
    my $prefix = $module->getOption('prefix');

    $prefix = $kdedir unless $prefix;

    # Add global set-envs
    setup_module_environment ($module->buildContext());

    # 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", $module->getOption('libpath'));
    prepend_environment_path('LD_LIBRARY_PATH', @ld_dirs);

    my @path = ("$kdedir/bin", "$qtdir/bin", $module->getOption('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->name() ne 'kdelibs')
    {
        my $ctx = $module->buildContext();
        my $kdelibsModule = $ctx->lookupModule('kdelibs');
        my $kdelibsDir;
        $kdelibsDir = $kdelibsModule->getOption('kdedir') if $kdelibsModule;

        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->name() eq 'global';
}

# 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 = assert_isa(shift, 'Module');

    my $srcdir = $module->fullpath('source');

    if ($module->getOption('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)
    {
        # Avoid calling close subroutines in more than one routine.
        @main::atexit_subs = ();

        close STDERR; # No broken pipe warnings

        $ENV{'LC_ALL'} = 'C'; # Force untranslated output
        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->name() 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 = assert_isa(shift, 'Module');

    if (!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 ($module->getOption('run-tests') eq 'upload') {
        $make_target = 'Experimental';
    }

    # Step 2: Run the tests.
    # We scrape the output of the commands, so force the locale to be
    # untranslated.
    local $ENV{'LC_ALL'} = 'C';
    my $result = log_command($module, 'test-results', [ 'make', $make_target ]);
    if ($result != 0) {
        my $logdir = $module->getLogDir();
        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 = assert_isa(shift, 'Module');
    my $moduleName = $module->name();
    my $builddir = $module->fullpath('build');

    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->type() 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_system($module);
    return 1 if $module->getOption('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].";

        # TODO: This should be a simple phase to run.
        if ($module->getOption('run-tests'))
        {
            run_tests($module); # Don't fail if this fails... yet
        }

        # TODO: Likewise this should be a phase to run.
        if ($module->getOption('install-after-build'))
        {
            my $ctx = $module->buildContext();
            handle_install($ctx, $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 ($ctx, @modules) = @_;
    my $l10n = 'l10n-kde4';

    assert_isa($ctx, 'ksb::BuildContext');

    # Only filter if 'l10n' is actually present in list.
    my @matches = grep {$_->name() =~ /^(?:$l10n|l10n)$/} @modules;
    my $subdirs;

    return @modules if not scalar @matches;

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

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

    # Still no subdirs?  Use kde-langauges.
    $subdirs = $ctx->getOption('kde-languages') if not $subdirs;
    my $l10nModule = $ctx->lookupModule($l10n);

    for my $dir (split (' ', $subdirs))
    {
        my $newModule = Module->new($ctx, "$l10n/$dir");
        $newModule->cloneOptionsFrom($l10nModule);
        $ctx->addModule($newModule);
        push @modules, $newModule;
    }

    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 ($ipc, $ctx) = @_;
    my @build_done;
    my @modules = grep ($_->name() !~ /^(KDE\/)?kde-common$/, $ctx->modulesInPhase('build'));
    my @update_list = map { $_->name() } ($ctx->modulesInPhase('update'));
    my $result = 0;

    # 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 = $ctx->getLogDir() . '/build-status';
        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)
    {
        my $moduleSet = $module->moduleSet();
        my $moduleName = $module->name();

        if ($moduleSet) {
            note "Building g[$module] from g[$moduleSet] ($i/$num_modules)";
        }
        else {
            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.

        $svn_status{$moduleName} //= 0; # Default svn status if not defined.

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

            my $ipcType = $ipc->receiveIPCMessage(\$buffer);
            if (!$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 ($moduleName, $msg) = split(/,/, $buffer);
                $svn_status{$moduleName} = 'success';

                note "\tSource update complete for g[$moduleName]: $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';
                $ctx->markModulePhaseFailed('update', $module);
                print STATUS_FILE "$module: Failed on update.\n";
                $result = 1;
                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 = $module->getPersistentOption('failure-count') // 0;
                ++$fail_count;
                $module->setPersistentOption('failure-count', $fail_count);

                if ($ipcType == IPC::MODULE_CONFLICT)
                {
                    $module->setPersistentOption('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{$moduleName} eq 'failed';

        # The update process will send an IPC response for 'l10n-kde4', so we
        # must wait until after that response is received before filtering our
        # l10n module into the list of l10n-kde4/{$kde-languages}.
        # There will be no IPC updates for any l10n modules added from
        # filter_l10n_module_list, but that is OK, as the reading code above
        # only checks for modules that were in @update_list. The extra modules
        # added are *not* in @update_list, and so we don't expect IPC output
        # for them.
        if ($moduleName eq 'l10n-kde4') {
            # We've already pulled the module from @modules, make sure to pass
            # it back in to be filtered properly.
            @modules = filter_l10n_module_list($ctx, $module, @modules);
            next;
        }

        # 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 (!$module->getOption('build-when-unchanged') &&
            $svn_status{$moduleName} eq 'skipped' &&
            ($module->getPersistentOption('failure-count') // 0) == 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;
            $module->setPersistentOption('last-build-rev', current_module_revision($module));
            $module->setPersistentOption('failure-count', 0);

            info "\tOverall time for g[$module] was g[$elapsed].";
            push @build_done, $moduleName;
        }
        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].";
            $ctx->markModulePhaseFailed('build', $module);
            $result = 1;

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

            my $fail_count = $module->getPersistentOption('failure-count') // 0;
            ++$fail_count;
            $module->setPersistentOption('failure-count', $fail_count);

            if ($module->getOption('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 ($outfile)
    {
        close STATUS_FILE;

        # Update the symlink in latest to point to this file.
        my $logdir = get_subdir_path($ctx, '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($ctx);
        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 $result;
}

# 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 $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $exitcode = shift // 0;

    $ctx->storePersistentOptions();

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

    close_lock();

    my $logdir = $ctx->getLogDir();
    note "Your logs are saved in y[$logdir]";

    exit $exitcode;
}

# 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.
# 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 = assert_isa(shift, 'Module');
    my $source_dir = $module->fullpath('source');
    my $module_expected_url = svn_module_url($module);
    my $module_actual_url = get_svn_info($module, 'URL');

    $module_expected_url =~ s{/+$}{}; # Remove trailing slashes
    $module_actual_url   =~ s{/+$}{}; # Remove trailing slashes

    if ($module_actual_url ne $module_expected_url)
    {
        warning <<EOF;
 y[!!]
 y[!!] g[$module] seems to be checked out from somewhere other than expected.
 y[!!]

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

# 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 $ctx = assert_isa(shift, 'ksb::BuildContext');
    my @modules = @_;

    # Check all modules passed.
    map { assert_isa($_, 'Module') } @modules;

    @modules = filter_l10n_module_list($ctx, @modules);
    @modules = grep { $_->needsInstalled() } (@modules);

    my $result = 0;

    for my $module (@modules)
    {
        resetenv();
        my $moduleName = $module->name();

        update_module_environment ($module);

        my $builddir = $module->fullpath('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 ($module->getOption('use-clean-install') &&
            $module->getPersistentOption('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;
            $ctx->markModulePhaseFailed('install', $module);

            if ($module->getOption('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.

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

        my $remove_setting = $module->getOption('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 = $module->fullpath('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 $ctx = assert_isa(shift, 'ksb::BuildContext');
    my @modules = @_;

    # Check all modules passed.
    map { assert_isa($_, 'Module') } @modules;

    @modules = filter_l10n_module_list($ctx, @modules);
    @modules = grep { $_->needsInstalled() } (@modules);
    my $result = 0;

    for my $module (reverse @modules)
    {
        resetenv();
        my $moduleName = $module->name();
        update_module_environment ($module);

        my $builddir = $module->fullpath('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;
            $ctx->markModulePhaseFailed('uninstall', $module);

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

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

    return $result;
}

# This subroutine is used in order to apply any module-specific filtering that
# is necessary after reading command line and rc-file options. (This is as
# opposed to phase filters, which leave each module as-is but change the phases
# they operate part of, this function could remove a module entirely from the
# build).
#
# Famously used for --resume-from and --resume-after, but more could be added
# in theory.
#
# Requires a list of "Module" type objects, and returns the list with filters
# applied. Right now the return list will be a subset of the given list, but
# it's best not to rely on that long-term.
sub applyModuleFilters
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my @moduleList = @_;

    if (!$ctx->getOption('resume-from') && !$ctx->getOption('resume-after'))
    {
        debug "No --resume-from or --resume-after seems present.";
        return @moduleList;
    }

    if ($ctx->getOption('resume-from') && $ctx->getOption('resume-after'))
    {
        # This one's an error.
        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.");
    }

    my $resumePoint = $ctx->getOption('resume-from') ||
                      $ctx->getOption('resume-after');

    debug "Looking for $resumePoint for --resume-* option";

    # || 0 is a hack to force Boolean context.
    my $filterInclusive = $ctx->getOption('resume-from') || 0;
    my $found = 0;

    # If we already found our resume point, include this module. If this module
    # *is* the resume point, include it if filterInclusive is true, otherwise
    # just flag it. Module sets complicate the logic a bit, but it's basically
    # just harder in the --resume-after case where we have to leave that module
    # set before we can allow modules through the filter.
    my $filterTest = sub {
        if ($found) {
            return $filterInclusive || $_->moduleSet() ne $resumePoint;
        }
        $found = $_->{'name'} eq $resumePoint || $_->moduleSet() eq $resumePoint;
        return $found && $filterInclusive;
    };

    my @resultList = grep { &$filterTest } (@moduleList);

    if (!@resultList && @moduleList) {
        # Lost all modules somehow.
        die make_exception('Runtime', "Unknown resume point $resumePoint " .
                "when handling --resume-from or --resume-after.");
    }

    return @resultList;
}

# 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.
#
# You should pass in the options to run the program with as a list.
#
# Meant to implement the --run command line option.
sub execute_command_line_program
{
    my ($program, @args) = @_;

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

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

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

    exit 0 if pretending;

    exec $program, @args 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, $ctx) = @_;

    my $svnPid = fork;
    if ($svnPid == 0)
    { # child
        $ipc->setUpdater();
        # Avoid calling close subroutines in more than one routine.
        @main::atexit_subs = ();
        exit handle_updates ($ipc, $ctx);
    }

    # Parent
    my $monPid = fork;
    if ($monPid == 0)
    { # monitor
        $ipc->setMonitor();
        # Avoid calling close subroutines in more than one routine.
        @main::atexit_subs = ();
        exit handle_monitoring ($ipc);
    }

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

    # 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 $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $logdir = get_subdir_path($ctx, 'log-dir');

    return 0 if ! -e "$logdir/latest"; # Could happen for error on first run...

    # 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 (defined caller && caller eq 'test')
{
    print "kdesrc-build being run from testing framework, BRING IT.\n";
    print "kdesrc-build is version $versionNum\n";
    return 1;
}

my $ctx;
our @atexit_subs;

END {
    # Basically used to call the finish() handler but only when appropriate.
    foreach my $sub (@atexit_subs) {
        &$sub();
    }
}

# Use some exception handling to avoid ucky error messages
eval
{
    # preinit {{{
    # Note: Don't change the order around unless you're sure of what you're
    # doing.

    # Default to colorized output if sending to TTY
    ksb::Debug::setColorfulOutput(-t STDOUT);
    $ctx = ksb::BuildContext->new();
    my $pendingOptions = { };

    # Process --help, --install, etc. first.
    my @modules = process_arguments($ctx, $pendingOptions, @ARGV);

    # Change name and type of command line entries beginning with + to force
    # them to be XML project modules.
    foreach (@modules) {
        if (substr($_->{name}, 0, 1) eq '+') {
            debug "Forcing ", $_->name(), " to be an XML module";
            $_->{type} = 'proj';
            substr($_->{name}, 0, 1) = ''; # Remove first char
        }
    }

    my $fh = $ctx->loadRcFile();

    # If we're still here, read the options
    my @optionModules = read_options($ctx, $fh);
    close $fh;

    # Modify the options read from the rc-file to have the pending changes from
    # the command line.
    foreach my $pendingModule (keys %{$pendingOptions}) {
        my $options = ${$pendingOptions}{$pendingModule};
        my ($module) = grep { $pendingModule eq $_->name() } (@optionModules);

        if (!$module) {
            warning ("Tried to set options for unknown module b[y[$pendingModule]");
            next;
        }

        while (my ($key, $value) = each %{$options}) {
            debug "Setting pending option $key to $value for $pendingModule";
            $module->setOption($key, $value);
        }
    }

    # Check if we're supposed to drop into an interactive shell instead.  If so,
    # here's the stop off point.

    if (my $prog = $ctx->getOption('#start-program'))
    {
        # @modules is the command line arguments to pass in this case.
        execute_command_line_program($prog, @modules);
    }

    $ctx->setupOperatingEnvironment(); # i.e. niceness, ulimits, etc.

    my $commandLineModules = scalar @modules;

    # Allow named module-sets to be given on the command line.
    if ($commandLineModules) {
        # Copy Module objects from the ones created by read_options
        # since their module-type will actually be set.
        foreach my $module (@modules) {
            my ($optionModule) = grep {$_->name() eq $module->name()} @optionModules;
            $module = $optionModule if defined $optionModule;
        }

        # Filter --resume-foo first so entire module-sets can be skipped.
        @modules = applyModuleFilters($ctx, @modules);
        @modules = expandModuleSets(\@modules, \@optionModules);
        Module->setModuleSource('cmdline');
    }
    else {
        @modules = @optionModules;
        Module->setModuleSource('config');
    }

    # Filter --resume-foo options. This might be a second pass, but that should
    # be OK since there's nothing different going on from the first pass in that
    # event.
    @modules = applyModuleFilters($ctx, @modules);
    @modules = expandXMLModules($ctx, @modules);

    # If modules were on the command line then they are effectively forced to
    # process unless overridden by command line options as well. If phases
    # *were* overridden on the command line, then no update pass is required
    # (all modules already have correct phases)
    @modules = updateModulePhases(@modules) unless $commandLineModules;

    # Add to global module list now that we've filtered everything.
    $ctx->addModule($_) foreach @modules;

    if (exists $ENV{KDESRC_BUILD_DUMP_CONTEXT}) {
        local $Data::Dumper::Indent = 1;
        local $Data::Dumper::Sortkeys = 1;

        # This method call dumps the first list with the variables named by the
        # second list.
        print Data::Dumper->Dump([$ctx], [qw(ctx)]);
    }

    if (!pretending() && !get_lock($ctx))
    {
        print "$0 is already running!\n";
        exit 0; # Don't finish(), it's not our lockfile!!
    }
    else
    {
        my $curPid = $$;
        push @atexit_subs, sub { finish($ctx, 99) if $$ == $curPid };
    }
    # }}}

    # execution phase {{{
    my $time = localtime;
    info "Script started processing at g[$time]" unless pretending;

    $ctx->loadPersistentOptions();

    my $result;
    my @update_list = map { $_->name() } ($ctx->modulesInPhase('update'));
    my @build_list = map { $_->name() } ($ctx->modulesInPhase('build'));

    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(); # TODO: Unbreak my munge, say you'll work again.

    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.
        my $ipc = 0;

        if ($ctx->getOption('async'))
        {
            $ipc = new PipeIPC;
        }

        if (!$ipc)
        {
            $ipc = new NullIPC;
            whisper "Using no IPC mechanism\n";

            $result = handle_updates ($ipc, $ctx);
            $result = handle_build ($ipc, $ctx) || $result;
        }
        else
        {
            $result = handle_async_build ($ipc, $ctx);
        }
    }
    elsif ($run_mode eq 'install')
    {
        # Installation mode
        my @installList = $ctx->modulesInPhase('install');

        $result = handle_install ($ctx, @installList);
    }
    elsif ($run_mode eq 'uninstall')
    {
        my @uninstallList = $ctx->modulesInPhase('uninstall');

        # Make handle_uninstall handle in right order (it reverses the order
        # so that the first module uninstalled is the last one installed).
        if (Module->moduleSource() eq 'cmdline') {
            @uninstallList = reverse @uninstallList;
        }

        $result = handle_uninstall ($ctx, @uninstallList);
    }

    cleanup_log_directory($ctx) if $ctx->getOption('purge-old-logs');
    output_failed_module_lists($ctx);

    $time = localtime;
    my $color = '';
    $color = 'r[' if $result;

    info "${color}Script finished processing at g[$time]" unless pretending;

    @atexit_subs = (); # Clear exit handlers
    finish($ctx, $result);

    # }}}
};

if (my $err = $@)
{
    if (ref $err && $err->isa('BuildException')) {
        print $err->{'exception_type'}, " error: ", $err->{'message'}, "\n";
        print "\tCan't continue, so stopping now.\n";

        if ($err->{'exception_type'} eq 'Internal') {
            print "\nPlease submit a bug against kdesrc-build on http://bugs.kde.org/\n"
        }
    }
    else {
        # We encountered an error.
        print "Encountered an error in the execution of the script.\n";
        print "The error reported was $err\n";
        print "Please submit a bug against kdesrc-build on http://bugs.kde.org/\n";
    }

    exit 99;
}

# vim: set et sw=4 ts=4 fdm=marker:
