diff --git a/kdesrc-build b/kdesrc-build index 066856f..89690ae 100755 --- a/kdesrc-build +++ b/kdesrc-build @@ -43,7 +43,6 @@ use POSIX qw(strftime :sys_wait_h _exit); use File::Find; # For our lndir reimplementation. use File::Path qw(remove_tree); use File::Glob ':glob'; -use File::Basename; # fileparse use File::Spec; # tmpdir, rel2abs use File::Temp qw(tempfile); use LWP::UserAgent; @@ -66,7 +65,6 @@ $SIG{__DIE__} = \&Carp::confess; 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 }; @@ -2432,13 +2430,21 @@ HOME our @ISA = ('UpdateHandler'); + use File::Basename; # basename + use File::Spec; # tmpdir + use POSIX qw(strftime); + + use constant { + DEFAULT_GIT_REMOTE => 'origin', + }; + # scm-specific update procedure. # May change the current directory as necessary. # Assumes called as part of a Module (i.e. $self->isa('Module') should be true. sub updateInternal { my $self = assert_isa(shift, 'GitUpdate'); - return main::update_module_git_checkout($self->module()); + return $self->updateCheckout(); } sub name @@ -2449,1375 +2455,1670 @@ HOME sub currentRevisionInternal { my $self = assert_isa(shift, 'GitUpdate'); - return main::git_commit_id($self->module()); + return $self->commit_id('HEAD'); } - 1; -} -# }}} + # Returns the current sha1 of the given git "commit-ish". + sub commit_id + { + my $self = assert_isa(shift, 'GitUpdate'); + my $commit = shift or croak_internal("Must specify git-commit to retrieve id for"); + my $module = $self->module(); -# package BzrUpdate {{{ -# Support the bazaar source control manager for libdbusmenu-qt -{ - package BzrUpdate; + my $gitdir = $module->fullpath('source') . '/.git'; - ksb::Debug->import(); - ksb::Util->import(); + # Note that the --git-dir must come before the git command itself. + my ($id, undef) = filter_program_output( + undef, # No filter + qw/git --git-dir/, $gitdir, 'rev-parse', $commit, + ); + chomp $id if $id; - # Our superclass - our @ISA = ('UpdateHandler'); + return $id; + } - # scm-specific update procedure. - # May change the current directory as necessary. - # Should return a count of files changed (or commits, or something similar) - sub updateInternal + # Perform a git clone to checkout the latest branch of a given git module + # + # First parameter is the repository (typically URL) to use. + # Returns boolean true if successful, false otherwise. + sub clone { - my $self = assert_isa(shift, 'BzrUpdate'); - my $module = assert_isa($self->module(), 'Module'); - - # Full path to source directory on-disk. + my $self = assert_isa(shift, 'GitUpdate'); + my $git_repo = shift; + my $module = $self->module(); my $srcdir = $module->fullpath('source'); - my $bzrRepoName = $module->getOption('repository'); + my @args = ('--', $git_repo, $srcdir); - # Or whatever regex is appropriate to strip the bzr URI protocol. - $bzrRepoName =~ s/^bzr:\/\///; + # 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...) + if ($module->buildSystemType() eq 'Qt' && + $module->buildSystem()->forceProgressOutput()) + { + unshift (@args, '-v'); + } - if (! -e "$srcdir/.bzr") { - # Cmdline assumes bzr will create the $srcdir directory and then - # check the source out into that directory. - my @cmd = ('bzr', 'branch', $bzrRepoName, $srcdir); + note ("Cloning g[$module]"); - # Exceptions are used for failure conditions - if (log_command($module, 'bzr-branch', \@cmd) != 0) { - die make_exception('Internal', "Unable to checkout $module!"); + my $result = ($self->installGitSnapshot()) || + 0 == log_command($module, 'git-clone', ['git', 'clone', @args]); + + if ($result) { + $module->setPersistentOption('git-cloned-repository', $git_repo); + + my $branch = $self->getBranch(); + + # 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', $branch, "origin/$branch"]) == 0); } + } - # TODO: Filtering the output by passing a subroutine to log_command - # should give us the number of revisions, or we can just somehow - # count files. - my $newRevisionCount = 0; - return $newRevisionCount; + return ($result != 0); + } + + # Either performs the initial checkout or updates the current git checkout + # for git-using modules, as appropriate. + # + # If errors are encountered, an exception is raised using die(). + # + # Returns the number of *commits* affected. + sub updateCheckout + { + my $self = assert_isa(shift, 'GitUpdate'); + my $module = $self->module(); + my $srcdir = $module->fullpath('source'); + + if (-d "$srcdir/.git") { + # Note that this function will throw an exception on failure. + return $self->updateExistingClone(); } else { - # Update existing checkout. The source is currently in $srcdir - p_chdir($srcdir); + # 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]"); + main::safe_rmtree($srcdir) or do { + die "Unable to delete r[b[$srcdir]!"; + }; + } + else { + error (<getOption('repository'); + + if (!$git_repo) { + die "Unable to checkout $module, you must specify a repository to use."; + } + + $self->clone($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; } - sub name - { - return 'bzr'; - } - - # This is used to track things like the last successfully installed - # revision of a given module. - sub currentRevisionInternal - { - my $self = assert_isa(shift, 'BzrUpdate'); - my $module = $self->module(); + # Updates an already existing git checkout by running git pull. + # + # Return parameter is the number of affected *commits*. Errors are + # returned only via exceptions because of this. + sub updateExistingClone + { + my $self = assert_isa(shift, 'GitUpdate'); + my $module = $self->module(); + my $srcdir = $module->fullpath('source'); + my $cur_repo = $module->getOption('repository'); + my $branch = $self->getBranch(); my $result; - # filter_program_output can throw exceptions - eval { - p_chdir($module->fullpath('source')); + p_chdir($srcdir); - ($result, undef) = filter_program_output(undef, 'bzr', 'revno'); - chomp $result; - }; + note ("Updating g[$module] (to branch b[$branch])"); + my $start_commit = $self->commit_id('HEAD'); - if ($@) { - error ("Unable to run r[b[bzr], is bazaar installed?"); - error (" -- Error was: r[$@]"); - return undef; + # Search for an existing remote name first. If none, add our alias. + my @remoteNames = $self->bestRemoteName($cur_repo); + my $remoteName = DEFAULT_GIT_REMOTE; + + if (@remoteNames) { + $remoteName = $remoteNames[0]; } + else { + # The desired repo doesn't have a named remote, this should be + # because the user switched it in the rc-file. We control the + # 'origin' remote to fix this. + if ($self->hasRemote(DEFAULT_GIT_REMOTE)) { + if (log_command($module, 'git-update-remote', + ['git', 'remote', 'set-url', DEFAULT_GIT_REMOTE, $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', DEFAULT_GIT_REMOTE, $cur_repo]) + != 0) + { + die "Unable to add a git remote named " . DEFAULT_GIT_REMOTE . " for $cur_repo"; + } - return $result; - } + push @remoteNames, DEFAULT_GIT_REMOTE; + } - 1; -} -# }}} + my $old_repo = $module->getPersistentOption('git-cloned-repository'); + if ($old_repo and ($cur_repo ne $old_repo)) { + note (" y[b[*]\ty[$module]'s selected repository has changed"); + note (" y[b[*]\tfrom y[$old_repo]"); + note (" y[b[*]\tto b[$cur_repo]"); + note (" y[b[*]\tThe git remote named b[", DEFAULT_GIT_REMOTE, "] has been updated"); -# package SvnUpdate {{{ -{ - package SvnUpdate; + # Update what we think is the current repository on-disk. + $module->setPersistentOption('git-cloned-repository', $cur_repo); + } - ksb::Debug->import(); - ksb::Util->import(); + # 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"; + } - our @ISA = ('UpdateHandler'); + # 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 = $self->getRemoteBranchName(\@remoteNames, $branch); - # 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 + if (!$branchName) { + my $newName = $self->makeBranchname(\@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 ($self->stashAndUpdate()) { + return count_command_output('git', 'rev-list', "$start_commit..HEAD"); + } + else { + # We must throw an exception if we fail. + die "Unable to update $module"; + } + } + + # Returns the user-selected branch for the given module, or 'master' if no + # branch was selected. + # + # First parameter is the module name. + sub getBranch { - my $moduleName = shift; + my $self = assert_isa(shift, 'GitUpdate'); + my $module = $self->module(); + my $branch = $module->getOption('branch'); - return $moduleName =~ /^(extragear|playground|KDE)(\/[^\/]+)?$/; + if (!$branch && $module->getOption('use-stable-kde')) { + my $stable = $module->getOption('#branch:stable'); + if ($stable && $stable ne 'none') { + $branch = $stable; + } + } + + $branch ||= 'master'; # If no branch, use 'master' + return $branch; } - # Subroutine to return the branch prefix. i.e. the part before the branch - # name and module name. + # 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 source directory. # - # 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. + # After installing the tarball, an immediate git pull will be run to put the + # module up-to-date. The branch is not updated however! # - # Ex: 'kdelibs' => 'branches/KDE' - # 'kdevelop' => 'branches/kdevelop' - sub _branch_prefix + # 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). + # + # Returns boolean true on success, false otherwise. + sub installGitSnapshot { - my $moduleName = shift; - my $type = shift; + my $self = assert_isa(shift, 'GitUpdate'); + my $module = $self->module(); + my $tarball = $module->getOption('#snapshot-tarball'); - # These modules seem to have their own subdir in /tags. - my @tag_components = qw/arts koffice amarok kst qt taglib/; + return 0 if $module->getOption('disable-snapshots'); + return 0 unless $tarball; - # 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/-base-artwork -wallpapers accessibility - addons admin artwork base bindings edu games graphics libs - network pim pimlibs plasma-addons sdk toys utils webdev/)); + if (pretending()) { + pretend ("\tWould have downloaded snapshot for g[$module], from"); + pretend ("\tb[g[$tarball]"); + return 1; + } - # If the user already has the module in the form KDE/foo, it's already - # done. - return "$type/KDE" if $moduleName =~ /^KDE\//; + info ("\tDownloading git snapshot for g[$module]"); - # KDE proper modules seem to use this pattern. - return "$type/KDE" if list_has(\@kde_module_list, $moduleName); + my $filename = basename(URI->new($tarball)->path()); + my $tmpdir = File::Spec->tmpdir() // "/tmp"; + $filename = "$tmpdir/$filename"; # Make absolute - # KDE extragear / playground modules use this pattern - return "$type" if _has_base_module($moduleName); + if (!main::download_file($tarball, $filename)) { + error ("Unable to download snapshot for module r[$module]"); + return 0; + } - # 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); + info ("\tDownload complete, preparing module source code"); - # Everything else. - return "$type/$moduleName"; - } + # 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); - # 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\///; + my $result = safe_system(qw(tar --strip-components 1 -C), + $sourceDir, '-xf', $filename); + my $savedError = $!; # Avoid interference from safe_unlink + safe_unlink ($filename); - return $moduleName; - } + if ($result) { + error ("Unable to extract snapshot for r[b[$module]: $savedError"); + main::safe_rmtree($sourceDir); + return 0; + } - # 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'); + whisper ("\tg[$module] snapshot is in place"); - # Remove trailing slashes. - $svn_server =~ s/\/*$//; + # Complete the preparation by running the initrepo.sh script + p_chdir($sourceDir); + $result = log_command($module, 'init-git-repo', ['/bin/sh', './initrepo.sh']); - # Remove KDE/ prefix for module name. - my $moduleName = _moduleBaseName($module->name()); + if ($result) { + error ("Snapshot for r[$module] extracted successfully, but failed to complete initrepo.sh"); + main::safe_rmtree($sourceDir); + return 0; + } - # KDE modules have a different module naming scheme than the rest it seems. - return "$svn_server/$branch/$branchname/$moduleName" if $branch =~ /\/KDE\/?$/; + whisper ("\tConverting to kde:-style URL"); + $result = log_command($module, 'fixup-git-remote', + ['git', 'remote', 'set-url', 'origin', "kde:$module"]); - # 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"; + if ($result) { + warning ("\tUnable to convert origin URL to kde:-style URL. Things should"); + warning ("\tstill work, you may have to adjust push URL manually."); } - # 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"; + info ("\tGit snapshot installed, now bringing up to date."); + $result = log_command($module, 'init-git-pull', ['git', 'pull']); + return ($result == 0); } - # 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 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. # - # 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 + # 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 stashAndUpdate { - my $self = assert_isa(shift, 'SvnUpdate'); + my $self = assert_isa(shift, 'GitUpdate'); my $module = $self->module(); - my $svn_server = $module->getOption('svn-server'); - my $modulePath; + my $date = strftime ("%F-%R", gmtime()); # ISO Date, hh:mm time - foreach my $levelLimit ('module', 'allow-inherit') { - $modulePath = $module->getOption('module-base-path', $levelLimit); + # 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'); - # 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 ($status == -1 || $status & 127) { + croak_runtime("$module doesn't appear to be a git module."); + } - if($module->getOption('tag', $levelLimit)) - { - return _handle_branch_tag_option($module, 'tags'); + my $needsStash = 0; + if ($status) { + # There are local changes. + $needsStash = 1; + } + else { + $status = pretending() ? 0 : system('git', 'diff', '--cached', '--quiet'); + if ($status == -1 || $status & 127) { + croak_runtime("$module doesn't appear to be a git module."); } - - my $branch = $module->getOption('branch', $levelLimit); - if($branch and $branch ne 'trunk') - { - return _handle_branch_tag_option($module, 'branches'); + else { + $needsStash = ($status != 0); } + } - my $moduleName = _moduleBaseName($module->name()); + 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) { + croak_runtime("Unable to stash local changes for $module, aborting update."); + } + } - # 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 KDE kdereview www l10n-kde4); + $status = log_command($module, 'git-pull-rebase', [ + qw(git pull --rebase --quiet) + ]); - my $module_root = $moduleName; - $module_root =~ s/\/.*//; # Remove everything after the first slash + if ($status != 0) { + error ("Unable to update the source code for r[b[$module]"); + return 0; + } - 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. + # 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 (<module(); - my $source_dir = $module->fullpath('source'); - my $module_expected_url = $self->svn_module_url(); - my $module_actual_url = $self->svnInfo('URL'); - - $module_expected_url =~ s{/+$}{}; # Remove trailing slashes - $module_actual_url =~ s{/+$}{}; # Remove trailing slashes - - if ($module_actual_url ne $module_expected_url) - { - # Check if the --src-only flag was passed. - if ($module->buildContext()->getOption('#allow-auto-repo-move')) - { - note ("g[$module] is checked out from a different location than expected."); - note ("Attempting to correct"); + my $self = assert_isa(shift, 'GitUpdate'); + my $remoteNamesRef = shift; + my $branchName = shift; - log_command($module, 'svn-switch', ['svn', 'switch', $module_expected_url]); - return; - } + # Dereference our remote names. + my @remoteNames = @{$remoteNamesRef}; - warning (<module(); - my $numChanged = 0; + my $self = assert_isa(shift, 'GitUpdate'); + my $repoUrl = shift; + my @outputs; - # If we have elements in @path, download them now - for my $dir (@_) - { - info ("\tUpdating g[$dir]"); + # 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 ./ + ); + }; - my $logname = $dir; - $logname =~ tr{/}{-}; + if ($@) { + error ("Unable to run git config, is there a setup error?"); + return; + } - my $count = $self->run_svn("svn-up-$logname", [ 'svn', 'up', $dir ]); - $numChanged = undef unless defined $count; - $numChanged += $count if defined $numChanged; + my @results; + foreach my $output (@outputs) { + # git config output between key/val is divided by newline. + my ($remoteName, $url) = split(/\n/, $output); + + $remoteName =~ s/^remote\.//; + $remoteName =~ s/\.url$//; # Extract the cruft + + # Skip other remotes + next if $url ne $repoUrl; + + # Try to avoid "weird" remote names. + next if $remoteName !~ /^[\w-]*$/; + + # A winner is this one. + push @results, $remoteName; } - return $numChanged; + return @results; } - # 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. + # 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 local branch name will be equal to the remote branch name to match usual + # Git convention. + # * 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. # - # The first parameter is the module to checkout (including extragear and - # playground modules). - # All remaining parameters are subdirectories of the module to checkout. + # As with nearly all git support functions, 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. # - # Returns number of files affected, or undef. - sub checkout_module_path + # 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. See also + # "bestRemoteName" + # 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 makeBranchname { - my $self = assert_isa(shift, 'SvnUpdate'); + my $self = assert_isa(shift, 'GitUpdate'); + my $remoteNamesRef = shift; + my $branch = shift; my $module = $self->module(); - my @path = @_; - my %pathinfo = main::get_module_path_dir($module, 'source'); - my @args; + my $chosenName; + + # Use "$branch" directly if not already used, otherwise try + # to prefix with the best remote name or origin. + my $bestRemoteName = $remoteNamesRef ? $remoteNamesRef->[0] : 'origin'; + for my $possibleBranch ($branch, "$bestRemoteName-$branch", "origin-$branch") { + my @known_branches = eval { + # undef == no filter + filter_program_output(undef, 'git', 'branch', '--list', $possibleBranch) + }; - if (not -e $pathinfo{'path'} and not super_mkdir($pathinfo{'path'})) - { - croak_runtime ("Unable to create path r[$pathinfo{path}]!"); + # The desired branch name is OK as-is if no exceptions were thrown and + # the branch wasn't already known to git. + return $possibleBranch if !@known_branches && !$@; } - p_chdir ($pathinfo{'path'}); + croak_runtime("Unable to find good branch name for $module branch name $branch"); + } - my $svn_url = $self->svn_module_url(); - my $modulename = $pathinfo{'module'}; # i.e. kdelibs for KDE/kdelibs as $module + # 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 + { + # Don't call with $self->, all args are passed to filter_program_output + my @args = @_; + my $count = 0; - 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; + filter_program_output(sub { $count++ if $_ }, @args); + return $count; + } - note ("Checking out g[$module]"); + # A simple wrapper that is used to split the output of 'git config --null' + # correctly. All parameters are then passed to filter_program_output (so look + # there for help on usage). + sub slurp_git_config_output + { + # Don't call with $self->, all args are passed to filter_program_output + local $/ = "\000"; # Split on null - my $count = $self->run_svn('svn-co', \@args); + # This gets rid of the trailing nulls for single-line output. (chomp uses + # $/ instead of hardcoding newline + chomp(my @output = filter_program_output(undef, @_)); # No filter + return @output; + } - p_chdir ($pathinfo{'module'}) if scalar @path; + # Returns true if the git module in the current directory has a remote of the + # name given by the first parameter. + sub hasRemote + { + my ($self, $remote) = @_; + my $hasRemote = 0; - my $count2 = $self->update_module_subdirectories(@path); + eval { + filter_program_output(sub { $hasRemote ||= ($_ && /^$remote/) }, 'git', 'remote'); + }; - return $count + $count2 if defined $count and defined $count2; - return undef; + return $hasRemote; } - # Update a module that has already been checked out, along with any - # subdirectories the user desires. + # Subroutine to add the 'kde:' alias to the user's git config if it's not + # already set. # - # This function will throw an exception in the event of an update failure. + # Call this as a static class function, not as an object method + # (i.e. GitUpdate::verifyGitConfig, not $foo->verifyGitConfig) # - # 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 ($self, @path) = @_; - assert_isa($self, 'SvnUpdate'); - my $module = $self->module(); - my $fullpath = $module->fullpath('source'); - my @args; + # Returns false on failure of any sort, true otherwise. + sub verifyGitConfig + { + my $configOutput = + qx'git config --global --get url.git://anongit.kde.org/.insteadOf kde:'; + + # 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 (?)', + ); - p_chdir ($fullpath); + $error = $errors{$errNum} if exists $errors{$errNum}; + error (" r[*] Unable to run b[git] command:\n\t$error"); + return 0; + } - push @args, ('svn', 'up', '--non-interactive'); - push @args, '-N' if scalar @path; + # 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; + } - note ("Updating g[$module]"); + $configOutput = + qx'git config --global --get url.git@git.kde.org:.pushInsteadOf kde:'; - my $count = eval { $self->run_svn('svn-up', \@args); }; + 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; + } - # Update failed, try svn cleanup. - if ($@ && $@->{exception_type} ne 'ConflictPresent') - { - info ("\tUpdate failed, trying a cleanup."); - my $result = safe_system('svn', 'cleanup'); - $result == 0 or croak_runtime ("Unable to update $module, " . - "svn cleanup failed with exit code $result"); + return 1; + } - info ("\tCleanup complete."); + 1; +} +# }}} - # Now try again (allow exception to bubble up this time). - $count = $self->run_svn('svn-up-2', \@args); - } +# package BzrUpdate {{{ +# Support the bazaar source control manager for libdbusmenu-qt +{ + package BzrUpdate; - my $count2 = $self->update_module_subdirectories(@path); + ksb::Debug->import(); + ksb::Util->import(); - return $count + $count2 if defined $count and defined $count2; - return undef; - } + # Our superclass + our @ISA = ('UpdateHandler'); - # 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 + # scm-specific update procedure. + # May change the current directory as necessary. + # Should return a count of files changed (or commits, or something similar) + sub updateInternal { - my $sig_dir = "$ENV{HOME}/.subversion/auth/svn.ssl.server"; - my $sig_file = "ec08b331e2e6cabccb6c3e17a85e28ce"; + my $self = assert_isa(shift, 'BzrUpdate'); + my $module = assert_isa($self->module(), 'Module'); - debug ("Checking $sig_dir/$sig_file for KDE SSL signature."); + # Full path to source directory on-disk. + my $srcdir = $module->fullpath('source'); + my $bzrRepoName = $module->getOption('repository'); - if (-e "$sig_dir/$sig_file") - { - debug ("KDE SSL Signature file present."); - return; - } - - debug ("No KDE SSL Signature found."); - return if pretending(); + # Or whatever regex is appropriate to strip the bzr URI protocol. + $bzrRepoName =~ s/^bzr:\/\///; - # 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"); + if (! -e "$srcdir/.bzr") { + # Cmdline assumes bzr will create the $srcdir directory and then + # check the source out into that directory. + my @cmd = ('bzr', 'branch', $bzrRepoName, $srcdir); - # Make sure the directory is created. - if (!super_mkdir($sig_dir)) - { - error ("Unable to create r[Subversion signature] directory!"); - error ("$!"); + # Exceptions are used for failure conditions + if (log_command($module, 'bzr-branch', \@cmd) != 0) { + die make_exception('Internal', "Unable to checkout $module!"); + } - return; + # TODO: Filtering the output by passing a subroutine to log_command + # should give us the number of revisions, or we can just somehow + # count files. + my $newRevisionCount = 0; + return $newRevisionCount; } + else { + # Update existing checkout. The source is currently in $srcdir + p_chdir($srcdir); - 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 \ parts (the gibberish should be one big long - # line). - $sig_data =~ s/\\\n//gm; - - open (my $sig, '>', "$sig_dir/$sig_file") or do { - error ("Unable to open KDE SSL signature file!"); - error ("r[$!]"); + if (log_command($module, 'bzr-up', ['bzr', 'up']) != 0) { + die make_exception('Internal', "Unable to update $module!"); + } - return; - }; + # I haven't looked at bzr up output yet to determine how to find + # number of affected files or number of revisions skipped. + my $changeCount = 0; + return $changeCount; + } - print $sig $sig_data or do { - error ("Unable to write to KDE SSL signature file!"); - error ("r[$!]"); - }; + return 0; + } - close $sig; + sub name + { + return 'bzr'; } - # 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 + # This is used to track things like the last successfully installed + # revision of a given module. + sub currentRevisionInternal { - my ($self, $logfilename, $arg_ref) = @_; - assert_isa($self, 'SvnUpdate'); + my $self = assert_isa(shift, 'BzrUpdate'); my $module = $self->module(); + my $result; - 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; - } + # filter_program_output can throw exceptions + eval { + p_chdir($module->fullpath('source')); - my $count = 0; - my $conflict = 0; + ($result, undef) = filter_program_output(undef, 'bzr', 'revno'); + chomp $result; + }; - my $callback = sub { - return unless $_; + if ($@) { + error ("Unable to run r[b[bzr], is bazaar installed?"); + error (" -- Error was: r[$@]"); + return undef; + } - # 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++ if /^[UPDARGMC][ A-Z]/; - $conflict = 1 if /^C[ A-Z]/; - }; + return $result; + } - # Do svn update. - my $result = log_command($module, $logfilename, $arg_ref, { callback => $callback }); + 1; +} +# }}} - return 0 if pretending(); +# package SvnUpdate {{{ +{ + package SvnUpdate; - croak_runtime("Error updating $module!") unless $result == 0; + ksb::Debug->import(); + ksb::Util->import(); - if ($conflict) - { - warning ("Source code conflict exists in r[$module], this module will not"); - warning ("build until it is resolved."); + our @ISA = ('UpdateHandler'); - # 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 make_exception('ConflictPresent', "Source conflicts exist in $module"); - } + # 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 $count; + return $moduleName =~ /^(extragear|playground|KDE)(\/[^\/]+)?$/; } - # Subroutine to check for subversion conflicts in a module. Basically just - # runs svn st and looks for "^C". + # Subroutine to return the branch prefix. i.e. the part before the branch + # name and module name. # - # First parameter is the module to check for conflicts on. - # Returns 0 if a conflict exists, non-zero otherwise. - sub module_has_conflict + # 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 $module = assert_isa(shift, 'Module'); - my $srcdir = $module->fullpath('source'); + my $moduleName = shift; + my $type = shift; - if ($module->getOption('no-svn')) - { - whisper ("\tSource code conflict check skipped."); - return 1; - } - else - { - info ("\tChecking for source conflicts... "); - } + # These modules seem to have their own subdir in /tags. + my @tag_components = qw/arts koffice amarok kst qt taglib/; - my $pid = open my $svnProcess, "-|"; - if (!$pid) - { - error ("\tUnable to open check source conflict status: b[r[$!]"); - return 0; # false allows the build to proceed anyways. - }; + # 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/-base-artwork -wallpapers accessibility + addons admin artwork base bindings edu games graphics libs + network pim pimlibs plasma-addons sdk toys utils webdev/)); - if (0 == $pid) - { - # Avoid calling close subroutines in more than one routine. - @main::atexit_subs = (); + # If the user already has the module in the form KDE/foo, it's already + # done. + return "$type/KDE" if $moduleName =~ /^KDE\//; - close STDERR; # No broken pipe warnings + # KDE proper modules seem to use this pattern. + return "$type/KDE" if list_has(\@kde_module_list, $moduleName); - disable_locale_message_translation(); - exec {'svn'} (qw/svn --non-interactive st/, $srcdir) or - croak_runtime("Cannot execute 'svn' program: $!"); - # Not reached - } + # KDE extragear / playground modules use this pattern + return "$type" if _has_base_module($moduleName); - while (<$svnProcess>) - { - if (/^C/) - { - error (<isa('Module') should be true. - sub updateInternal + # 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 $self = assert_isa(shift, 'SvnUpdate'); - my $module = $self->module(); - my $fullpath = $module->fullpath('source'); - my @options = split(' ', $module->getOption('checkout-only')); + 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'); - if (-e "$fullpath/.svn") { - $self->check_module_validity(); - my $updateCount = $self->update_module_path(@options); + # Remove trailing slashes. + $svn_server =~ s/\/*$//; - my $log_filter = sub { - return unless defined $_; - print $_ if /^C/; - print $_ if /Checking for/; - return; - }; + # Remove KDE/ prefix for module name. + my $moduleName = _moduleBaseName($module->name()); - # Use log_command as the check so that an error file gets created. - if (0 != log_command($module, 'conflict-check', - ['kdesrc-build', 'SvnUpdate::module_has_conflict', - $module], - { callback => $log_filter, no_translate => 1 }) - ) - { - croak_runtime (" * Conflicts present in module $module"); - } + # KDE modules have a different module naming scheme than the rest it seems. + return "$svn_server/$branch/$branchname/$moduleName" if $branch =~ /\/KDE\/?$/; - return $updateCount; - } - else { - return $self->checkout_module_path(@options); + # 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"; } - } - - sub name - { - return 'svn'; - } - sub currentRevisionInternal - { - my $self = assert_isa(shift, 'SvnUpdate'); - return $self->svnInfo('Revision'); + # 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"; } - # Returns a requested parameter from 'svn info'. + # 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 # - # First parameter is a string with the name of the parameter to retrieve (e.g. 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 svnInfo + # 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 $self = assert_isa(shift, 'SvnUpdate'); my $module = $self->module(); + my $svn_server = $module->getOption('svn-server'); + my $modulePath; - my $param = shift; - my $srcdir = $module->fullpath('source'); - my $result; # Predeclare to outscope upcoming eval - - if (pretending() && ! -e $srcdir) { - return 'Unknown'; - } + foreach my $levelLimit ('module', 'allow-inherit') { + $modulePath = $module->getOption('module-base-path', $levelLimit); - # Search each line of output, ignore stderr. - # eval since filter_program_output uses exceptions. - eval - { - # Need to chdir into the srcdir, in case srcdir is a symlink. - # svn info /path/to/symlink barfs otherwise. - p_chdir ($srcdir); + # 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); + } - my @lines = filter_program_output( - sub { /^$param:/ }, - 'svn', 'info', '--non-interactive', '.' - ); + if($module->getOption('tag', $levelLimit)) + { + return _handle_branch_tag_option($module, 'tags'); + } - chomp ($result = $lines[0]); - $result =~ s/^$param:\s*//; - }; + my $branch = $module->getOption('branch', $levelLimit); + if($branch and $branch ne 'trunk') + { + return _handle_branch_tag_option($module, 'branches'); + } - if($@) - { - error ("Unable to run r[b[svn], is the Subversion program installed?"); - error (" -- Error was: r[$@]"); - return undef; - } + my $moduleName = _moduleBaseName($module->name()); - return $result; - } + # 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 KDE kdereview www l10n-kde4); - 1; -} -# }}} + my $module_root = $moduleName; + $module_root =~ s/\/.*//; # Remove everything after the first slash -# package GenericBuildSystem {{{ -{ - package GenericBuildSystem; + 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. + } - ksb::Debug->import(); - ksb::Util->import(); + last if $modulePath; + } - sub new - { - my ($class, $module) = @_; - return bless { module => $module }, $class; - } + # Remove trailing slashes. + $svn_server =~ s/\/*$//; - sub module - { - my $self = shift; - return $self->{module}; + # 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"; } - # Subroutine to determine if a given module needs to have the build system - # recreated from scratch. - # If so, it returns boolean true. - sub needsRefreshed + # 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 $self = assert_isa(shift, 'GenericBuildSystem'); + my $self = assert_isa(shift, 'SvnUpdate'); my $module = $self->module(); - my $builddir = $module->fullpath('build'); - my $confFileKey = $self->configuredModuleFileName(); + my $source_dir = $module->fullpath('source'); + my $module_expected_url = $self->svn_module_url(); + my $module_actual_url = $self->svnInfo('URL'); - if (debugging()) + $module_expected_url =~ s{/+$}{}; # Remove trailing slashes + $module_actual_url =~ s{/+$}{}; # Remove trailing slashes + + if ($module_actual_url ne $module_expected_url) { - 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/$confFileKey"; - } + # Check if the --src-only flag was passed. + if ($module->buildContext()->getOption('#allow-auto-repo-move')) + { + note ("g[$module] is checked out from a different location than expected."); + note ("Attempting to correct"); - return 1 if ((not -e "$builddir") || - (-e "$builddir/.refresh-me") || - $module->getOption("refresh-build") || - (not -e "$builddir/$confFileKey")); + log_command($module, 'svn-switch', ['svn', 'switch', $module_expected_url]); + return; + } - return 0; - } + warning (<module(); + my $numChanged = 0; - sub name - { - return 'generic'; - } + # If we have elements in @path, download them now + for my $dir (@_) + { + info ("\tUpdating g[$dir]"); - # Return value style: boolean - sub buildInternal - { - my $self = shift; + my $logname = $dir; + $logname =~ tr{/}{-}; - return main::safe_make($self->module(), { - target => undef, - message => 'Compiling...', - 'make-options' => [ - split(' ', $self->module()->getOption('make-options')), - ], - logbase => 'build', - subdirs => [ - split(' ', $self->module()->getOption("checkout-only")) - ], - }) == 0; + my $count = $self->run_svn("svn-up-$logname", [ 'svn', 'up', $dir ]); + $numChanged = undef unless defined $count; + $numChanged += $count if defined $numChanged; + } + + return $numChanged; } - # Return value style: boolean - sub configureInternal + # 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 { - # It is possible to make it here if there's no source dir and if we're - # pretending. If we're not actually pretending then this should be a - # bug... - return 1 if pretending(); + my $self = assert_isa(shift, 'SvnUpdate'); + my $module = $self->module(); + my @path = @_; + my %pathinfo = main::get_module_path_dir($module, 'source'); + my @args; - croak_internal('We were not supposed to get to this point...'); - } + if (not -e $pathinfo{'path'} and not super_mkdir($pathinfo{'path'})) + { + croak_runtime ("Unable to create path r[$pathinfo{path}]!"); + } - # Returns name of file that should exist (relative to the module's build directory) - # if the module has been configured. - sub configuredModuleFileName - { - my $self = shift; - return 'Makefile'; - } + p_chdir ($pathinfo{'path'}); - # Runs the testsuite for the given module. - # Returns true if a testsuite is present and all tests passed, false otherwise. - sub runTestsuite - { - my $self = shift; - my $module = $self->module(); + my $svn_url = $self->svn_module_url(); + my $modulename = $pathinfo{'module'}; # i.e. kdelibs for KDE/kdelibs as $module - info ("\ty[$module] does not support the b[run-tests] option"); - return 0; - } + 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; - # Used to install a module (that has already been built, tested, etc.) - # All options passed are prefixed to the eventual command to be run. - # Returns boolean false if unable to install, true otherwise. - sub installInternal - { - my $self = shift; - my $module = $self->module(); - my @cmdPrefix = @_; + note ("Checking out g[$module]"); - return main::safe_make ($module, { - target => 'install', - message => "Installing g[$module]", - 'prefix-options' => [@cmdPrefix], - subdirs => [ split(' ', $module->getOption("checkout-only")) ], - }) == 0; - } + my $count = $self->run_svn('svn-co', \@args); - # Used to uninstall a previously installed module. - # All options passed are prefixed to the eventual command to be run. - # Returns boolean false if unable to uninstall, true otherwise. - sub uninstallInternal - { - my $self = shift; - my $module = $self->module(); - my @cmdPrefix = @_; + p_chdir ($pathinfo{'module'}) if scalar @path; - return main::safe_make ($module, { - target => 'uninstall', - message => "Uninstalling g[$module]", - 'prefix-options' => [@cmdPrefix], - subdirs => [ split(' ', $module->getOption("checkout-only")) ], - }) == 0; + my $count2 = $self->update_module_subdirectories(@path); + + return $count + $count2 if defined $count and defined $count2; + return undef; } - # 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 cleanBuildSystem + # 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 $self = assert_isa(shift, 'GenericBuildSystem'); + my ($self, @path) = @_; + assert_isa($self, 'SvnUpdate'); my $module = $self->module(); - my $srcdir = $module->fullpath('source'); - my $builddir = $module->fullpath('build'); + my $fullpath = $module->fullpath('source'); + my @args; - if (pretending()) - { - pretend ("\tWould have cleaned build system for g[$module]"); - return 1; - } + p_chdir ($fullpath); - # Use an existing directory - if (-e $builddir && $builddir ne $srcdir) - { - info ("\tRemoving files in build directory for g[$module]"); + push @args, ('svn', 'up', '--non-interactive'); + push @args, '-N' if scalar @path; - # 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', 'main::prune_under_directory', $builddir ])) - { - error (" r[b[*]\tFailed to clean build directory. Verify the permissions are correct."); - return 0; # False for this function. - } + note ("Updating g[$module]"); - # 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 (!super_mkdir ($builddir)) + my $count = eval { $self->run_svn('svn-up', \@args); }; + + # Update failed, try svn cleanup. + if ($@ && $@->{exception_type} ne 'ConflictPresent') { - error ("\tUnable to create directory r[$builddir]."); - return 0; + info ("\tUpdate failed, trying a cleanup."); + my $result = safe_system('svn', 'cleanup'); + $result == 0 or croak_runtime ("Unable to update $module, " . + "svn cleanup failed with exit code $result"); + + info ("\tCleanup complete."); + + # Now try again (allow exception to bubble up this time). + $count = $self->run_svn('svn-up-2', \@args); } - return 1; + my $count2 = $self->update_module_subdirectories(@path); + + return $count + $count2 if defined $count and defined $count2; + return undef; } - # Return convention: boolean - sub createBuildSystem + # 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 $self = assert_isa(shift, 'GenericBuildSystem'); - my $module = $self->module(); - my $builddir = $module->fullpath('build'); + my $sig_dir = "$ENV{HOME}/.subversion/auth/svn.ssl.server"; + my $sig_file = "ec08b331e2e6cabccb6c3e17a85e28ce"; - if (! -e "$builddir" && !super_mkdir("$builddir")) + debug ("Checking $sig_dir/$sig_file for KDE SSL signature."); + + if (-e "$sig_dir/$sig_file") { - error ("\tUnable to create build directory for r[$module]!!"); - return 0; + debug ("KDE SSL Signature file present."); + return; } - return 1; - } + debug ("No KDE SSL Signature found."); + return if pretending(); - 1; -} -# }}} + # 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"); -# package QMakeBuildSystem {{{ -{ - package QMakeBuildSystem; + # Make sure the directory is created. + if (!super_mkdir($sig_dir)) + { + error ("Unable to create r[Subversion signature] directory!"); + error ("$!"); - our @ISA = ('GenericBuildSystem'); + return; + } - ksb::Debug->import(); - ksb::Util->import(); + 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 +'; - sub name - { - return 'qmake'; - } + # Remove the \ parts (the gibberish should be one big long + # line). + $sig_data =~ s/\\\n//gm; - sub requiredPrograms - { - return qw{qmake}; - } + open (my $sig, '>', "$sig_dir/$sig_file") or do { + error ("Unable to open KDE SSL signature file!"); + error ("r[$!]"); - # Returns the absolute path to 'qmake'. Note the actual executable name may - # not necessarily be 'qmake' as some distributions rename it to allow for - # co-installability with Qt 3 (and 5...) - # If no suitable qmake can be found, undef is returned. - # This is a "static class method" i.e. use QMakeBuildSystem::absPathToQMake() - sub absPathToQMake - { - my @possibilities = qw/qmake qmake4 qmake-qt4 qmake-mac/; - return grep { main::absPathToExecutable($_) } @possibilities; + return; + }; + + print $sig $sig_data or do { + error ("Unable to write to KDE SSL signature file!"); + error ("r[$!]"); + }; + + close $sig; } - # Return value style: boolean - sub configureInternal + # 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 $self = assert_isa(shift, 'QMakeBuildSystem'); + my ($self, $logfilename, $arg_ref) = @_; + assert_isa($self, 'SvnUpdate'); my $module = $self->module(); - my $builddir = $module->fullpath('build'); - my $sourcedir = $module->fullpath('source'); - my @projectFiles = glob("$sourcedir/*.pro"); - if (!@projectFiles || !$projectFiles[0]) { - croak_internal("No *.pro files could be found for $module"); - } + my $revision = $module->getOption('revision'); + if ($revision ne '0') + { + my @tmp = @{$arg_ref}; - if (@projectFiles > 1) { - error (" b[r[*] Too many possible *.pro files for $module"); - return 0; + # Insert after first two entries, deleting 0 entries from the + # list. + splice @tmp, 2, 0, '-r', $revision; + $arg_ref = \@tmp; } - p_chdir($builddir); + my $count = 0; + my $conflict = 0; - my $qmake = absPathToQMake(); - return 0 unless $qmake; - return log_command($module, 'qmake', [ $qmake, $projectFiles[0] ]) == 0; - } + my $callback = sub { + return unless $_; - 1; -} -# }}} + # 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++ if /^[UPDARGMC][ A-Z]/; + $conflict = 1 if /^C[ A-Z]/; + }; -# package l10nSystem {{{ -{ - package l10nSystem; + # Do svn update. + my $result = log_command($module, $logfilename, $arg_ref, { callback => $callback }); - our @ISA = ('SvnUpdate', 'GenericBuildSystem'); + return 0 if pretending(); - ksb::Debug->import(); - ksb::Util->import(); + croak_runtime("Error updating $module!") unless $result == 0; - sub new - { - my ($class, $module) = @_; + if ($conflict) + { + warning ("Source code conflict exists in r[$module], this module will not"); + warning ("build until it is resolved."); - # Ensure associated module updates from the proper svn path. - # TODO: Support different localization branches? + # 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 make_exception('ConflictPresent', "Source conflicts exist in $module"); + } - $module->setOption('module-base-path', 'trunk/l10n-kde4'); - return bless { module => $module, needsRefreshed => 1 }, $class; + return $count; } - sub module + # 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 $self = shift; - return $self->{module}; - } + my $module = assert_isa(shift, 'Module'); + my $srcdir = $module->fullpath('source'); - sub configuredModuleFileName - { - # Not quite correct (we should be looking at each individual language - # but it at least keeps the process going. - return 'teamnames'; - } + if ($module->getOption('no-svn')) + { + whisper ("\tSource code conflict check skipped."); + return 1; + } + else + { + info ("\tChecking for source conflicts... "); + } - # Sets the directories that are to be checked out/built/etc. - # There should be one l10nSystem for the entire l10n build (i.e. add - # all required support dirs and languages). - sub setLanguageDirs - { - my ($self, @languageDirs) = @_; - $self->{l10n_dirs} = \@languageDirs; - } + my $pid = open my $svnProcess, "-|"; + if (!$pid) + { + error ("\tUnable to open check source conflict status: b[r[$!]"); + return 0; # false allows the build to proceed anyways. + }; - # Returns true if the given subdirectory (reference from the module's root source directory) - # can be built or not. Should be reimplemented by subclasses as appropriate. - sub isSubdirBuildable - { - my ($self, $subdir) = @_; - return ($subdir ne 'scripts' && $subdir ne 'templates'); - } + if (0 == $pid) + { + # Avoid calling close subroutines in more than one routine. + @main::atexit_subs = (); - sub prefixEnvironmentVariable - { - return 'CMAKE_PREFIX_PATH'; + close STDERR; # No broken pipe warnings + + disable_locale_message_translation(); + exec {'svn'} (qw/svn --non-interactive st/, $srcdir) or + croak_runtime("Cannot execute 'svn' program: $!"); + # Not reached + } + + while (<$svnProcess>) + { + if (/^C/) + { + error (<isa('Module') should be true. sub updateInternal { - my $self = assert_isa(shift, 'UpdateHandler'); + my $self = assert_isa(shift, 'SvnUpdate'); my $module = $self->module(); my $fullpath = $module->fullpath('source'); - my @dirs = @{$self->{l10n_dirs}}; + my @options = split(' ', $module->getOption('checkout-only')); if (-e "$fullpath/.svn") { $self->check_module_validity(); - my $count = $self->update_module_path(@dirs); + my $updateCount = $self->update_module_path(@options); - $self->{needsRefreshed} = 0 if $count == 0; - return $count; - } - else { - return $self->checkout_module_path(@dirs); + 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 (0 != log_command($module, 'conflict-check', + ['kdesrc-build', 'SvnUpdate::module_has_conflict', + $module], + { callback => $log_filter, no_translate => 1 }) + ) + { + croak_runtime (" * Conflicts present in module $module"); + } + + return $updateCount; + } + else { + return $self->checkout_module_path(@options); } } sub name { - return 'l10n'; - } - - # Returns a list of just the languages to install. - sub languages - { - my $self = assert_isa(shift, 'l10nSystem'); - my @langs = @{$self->{l10n_dirs}}; - - return grep { $self->isSubdirBuildable($_); } (@langs); + return 'svn'; } - # Buildsystem support section - - sub needsRefreshed + sub currentRevisionInternal { - my $self = shift; - - # Should be 1 except if no update happened. - return $self->{needsRefreshed}; + my $self = assert_isa(shift, 'SvnUpdate'); + return $self->svnInfo('Revision'); } - sub buildInternal + # Returns a requested parameter from 'svn info'. + # + # First parameter is a string with the name of the parameter to retrieve (e.g. 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 svnInfo { - my $self = assert_isa(shift, 'l10nSystem'); - my $builddir = $self->module()->fullpath('build'); - my @langs = $self->languages(); - my $result = 0; + my $self = assert_isa(shift, 'SvnUpdate'); + my $module = $self->module(); - $result = (main::safe_make($self->module(), { - target => undef, - message => "Building localization for language...", - logbase => "build", - subdirs => \@langs, - }) == 0) || $result; + my $param = shift; + my $srcdir = $module->fullpath('source'); + my $result; # Predeclare to outscope upcoming eval - return $result; - } + if (pretending() && ! -e $srcdir) { + return 'Unknown'; + } - sub configureInternal - { - my $self = assert_isa(shift, 'l10nSystem'); + # Search each line of output, ignore stderr. + # eval since filter_program_output uses exceptions. + eval + { + # Need to chdir into the srcdir, in case srcdir is a symlink. + # svn info /path/to/symlink barfs otherwise. + p_chdir ($srcdir); - my $builddir = $self->module()->fullpath('build'); - my @langs = $self->languages(); - my $result = 0; + my @lines = filter_program_output( + sub { /^$param:/ }, + 'svn', 'info', '--non-interactive', '.' + ); - for my $lang (@langs) { - my $prefix = $self->module()->installationPath(); - p_chdir("$builddir/$lang"); + chomp ($result = $lines[0]); + $result =~ s/^$param:\s*//; + }; - info ("\tConfiguring to build language $lang"); - $result = (log_command($self->module(), "cmake-$lang", - ['cmake', '-DCMAKE_INSTALL_PREFIX=' . $prefix]) == 0) || $result; + if($@) + { + error ("Unable to run r[b[svn], is the Subversion program installed?"); + error (" -- Error was: r[$@]"); + return undef; } return $result; } - sub installInternal - { - my $self = assert_isa(shift, 'l10nSystem'); - my $builddir = $self->module()->fullpath('build'); - my @langs = $self->languages(); + 1; +} +# }}} - return (main::safe_make($self->module(), { - target => 'install', - message => "Installing language...", - logbase => "install", - subdirs => \@langs, - }) == 0); - } +# package GenericBuildSystem {{{ +{ + package GenericBuildSystem; - # 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. - sub prepareFakeBuilddir - { - my $self = assert_isa(shift, 'l10nSystem'); - my $module = $self->module(); - my $builddir = $module->fullpath('build'); - my $srcdir = $module->fullpath('source'); + ksb::Debug->import(); + ksb::Util->import(); - # 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', 'main::safe_lndir', $srcdir, $builddir ]; + sub new + { + my ($class, $module) = @_; + return bless { module => $module }, $class; + } - info ("\tSetting up alternate build directory for l10n"); - return (0 == log_command ($module, 'create-builddir', $args)); + sub module + { + my $self = shift; + return $self->{module}; } - # 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. - # - # Return convention: boolean (inherited) - sub createBuildSystem + # Subroutine to determine if a given module needs to have the build system + # recreated from scratch. + # If so, it returns boolean true. + sub needsRefreshed { - my $self = assert_isa(shift, 'l10nSystem'); + my $self = assert_isa(shift, 'GenericBuildSystem'); my $module = $self->module(); my $builddir = $module->fullpath('build'); + my $confFileKey = $self->configuredModuleFileName(); - # l10n doesn't support srcdir != builddir, fake it. - whisper ("\tFaking builddir for g[$module]"); - if (!$self->prepareFakeBuilddir()) + if (debugging()) { - error ("Error creating r[$module] build system!"); - return 0; - } - - p_chdir ($builddir); - - my @langs = @{$self->{l10n_dirs}}; - @langs = grep { $self->isSubdirBuildable($_) } (@langs); - - foreach my $lang (@langs) { - my $cmd_ref = [ './scripts/autogen.sh', $lang ]; - if (log_command ($module, "build-system-$lang", $cmd_ref)) - { - error ("\tUnable to create build system for r[$module]"); - } + 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/$confFileKey"; } - $module->setOption('#reconfigure', 1); # Force reconfigure of the module + return 1 if ((not -e "$builddir") || + (-e "$builddir/.refresh-me") || + $module->getOption("refresh-build") || + (not -e "$builddir/$confFileKey")); - return 1; + return 0; } - 1; -} -# }}} - -# package KDEBuildSystem {{{ -{ - package KDEBuildSystem; - - ksb::Debug->import(); - ksb::Util->import(); - - our @ISA = ('GenericBuildSystem'); - - sub needsInstalled + # Returns true if the given subdirectory (reference from the module's root source directory) + # can be built or not. Should be reimplemented by subclasses as appropriate. + sub isSubdirBuildable { - my $self = shift; - - return 0 if $self->name() eq 'kde-common'; # Vestigial return 1; } - sub name + # Returns true if the buildsystem will give percentage-completion updates on its output. + # Such percentage updates will be searched for to update the kdesrc-build status. + sub isProgressOutputSupported { - return 'KDE'; + return 0; } - sub isProgressOutputSupported + # If this method returns a non-empty string, then that string is the name + # of an environment variable to prepend the module's installation prefix + # path to. Mostly a hack, but will have to do until there's a better scheme + # for giving integration points for build systems into the actual build + # process. + sub prefixEnvironmentVariable { - return 1; + return undef; } - sub prefixEnvironmentVariable + # 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 { - return 'CMAKE_PREFIX_PATH'; + return 1; } + # This should return a list of executable names that must be present to + # even bother attempting to use this build system. An empty list should be + # returned if there's no required programs. sub requiredPrograms { - return qw{cmake qmake}; + return; } - sub runTestsuite + sub name { - my $self = assert_isa(shift, 'KDEBuildSystem'); - my $module = $self->module(); - - # Note that we do not run safe_make, which should really be called - # safe_compile at this point. + return 'generic'; + } - # Step 1: Ensure the tests are built, oh wait we already did that when we ran - # CMake :) + # Return value style: boolean + sub buildInternal + { + my $self = shift; - my $make_target = 'test'; - if ($module->getOption('run-tests') eq 'upload') { - $make_target = 'Experimental'; - } + return main::safe_make($self->module(), { + target => undef, + message => 'Compiling...', + 'make-options' => [ + split(' ', $self->module()->getOption('make-options')), + ], + logbase => 'build', + subdirs => [ + split(' ', $self->module()->getOption("checkout-only")) + ], + }) == 0; + } - info ("\tRunning test suite..."); + # Return value style: boolean + sub configureInternal + { + # It is possible to make it here if there's no source dir and if we're + # pretending. If we're not actually pretending then this should be a + # bug... + return 1 if pretending(); - # Step 2: Run the tests. - my $numTests = -1; - my $countCallback = sub { - if ($_ && /([0-9]+) tests failed out of/) { - $numTests = $1; - } - }; + croak_internal('We were not supposed to get to this point...'); + } - my $result = log_command($module, 'test-results', - [ 'make', $make_target ], - { callback => $countCallback, no_translate => 1}); + # Returns name of file that should exist (relative to the module's build directory) + # if the module has been configured. + sub configuredModuleFileName + { + my $self = shift; + return 'Makefile'; + } - if ($result != 0) { - if ($numTests > 0) { - warning ("\t$numTests tests failed for y[$module], consult latest/$module/test-results.log for info"); - } - else { - warning ("\tSome tests failed for y[$module], consult latest/$module/test-results.log for info"); + # Runs the testsuite for the given module. + # Returns true if a testsuite is present and all tests passed, false otherwise. + sub runTestsuite + { + my $self = shift; + my $module = $self->module(); + + info ("\ty[$module] does not support the b[run-tests] option"); + return 0; + } + + # Used to install a module (that has already been built, tested, etc.) + # All options passed are prefixed to the eventual command to be run. + # Returns boolean false if unable to install, true otherwise. + sub installInternal + { + my $self = shift; + my $module = $self->module(); + my @cmdPrefix = @_; + + return main::safe_make ($module, { + target => 'install', + message => "Installing g[$module]", + 'prefix-options' => [@cmdPrefix], + subdirs => [ split(' ', $module->getOption("checkout-only")) ], + }) == 0; + } + + # Used to uninstall a previously installed module. + # All options passed are prefixed to the eventual command to be run. + # Returns boolean false if unable to uninstall, true otherwise. + sub uninstallInternal + { + my $self = shift; + my $module = $self->module(); + my @cmdPrefix = @_; + + return main::safe_make ($module, { + target => 'uninstall', + message => "Uninstalling g[$module]", + 'prefix-options' => [@cmdPrefix], + subdirs => [ split(' ', $module->getOption("checkout-only")) ], + }) == 0; + } + + # 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 cleanBuildSystem + { + my $self = assert_isa(shift, 'GenericBuildSystem'); + my $module = $self->module(); + my $srcdir = $module->fullpath('source'); + my $builddir = $module->fullpath('build'); + + if (pretending()) + { + pretend ("\tWould have cleaned build system for g[$module]"); + return 1; + } + + # Use an existing directory + if (-e $builddir && $builddir ne $srcdir) + { + 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', 'main::prune_under_directory', $builddir ])) + { + error (" r[b[*]\tFailed to clean build directory. Verify the permissions are correct."); + return 0; # False for this function. } - return 0; + # 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."); } - else { - info ("\tAll tests ran successfully."); + # or create the directory + elsif (!super_mkdir ($builddir)) + { + error ("\tUnable to create directory r[$builddir]."); + return 0; } return 1; } - sub configureInternal + # Return convention: boolean + sub createBuildSystem { - my $self = assert_isa(shift, 'KDEBuildSystem'); + my $self = assert_isa(shift, 'GenericBuildSystem'); my $module = $self->module(); + my $builddir = $module->fullpath('build'); - # Use cmake to create the build directory (sh script return value - # semantics). - if (main::safe_run_cmake ($module)) + if (! -e "$builddir" && !super_mkdir("$builddir")) { - error ("\tUnable to configure r[$module] with CMake!"); + error ("\tUnable to create build directory for r[$module]!!"); return 0; } @@ -3828,1976 +4129,1745 @@ EOF } # }}} -# package QtBuildSystem {{{ +# package QMakeBuildSystem {{{ { - package QtBuildSystem; + package QMakeBuildSystem; + + our @ISA = ('GenericBuildSystem'); ksb::Debug->import(); ksb::Util->import(); - our @ISA = ('GenericBuildSystem'); - - sub needsInstalled + sub name { - my $self = assert_isa(shift, 'QtBuildSystem'); - my $module = $self->module(); - return $module->getOption('qtdir') ne $module->fullpath('build'); + return 'qmake'; } - sub name + sub requiredPrograms { - return 'Qt'; + return qw{qmake}; } - # If coming from gitorious.org instead of KDE's mirror we should force on - # progress output to work around a gitorious.org clone bug. - sub forceProgressOutput + # Returns the absolute path to 'qmake'. Note the actual executable name may + # not necessarily be 'qmake' as some distributions rename it to allow for + # co-installability with Qt 3 (and 5...) + # If no suitable qmake can be found, undef is returned. + # This is a "static class method" i.e. use QMakeBuildSystem::absPathToQMake() + sub absPathToQMake { - my $self = assert_isa(shift, 'QtBuildSystem'); - my $module = $self->module(); - - return $module->getOption('repository') =~ /gitorious\.org\//; + my @possibilities = qw/qmake qmake4 qmake-qt4 qmake-mac/; + return grep { main::absPathToExecutable($_) } @possibilities; } # Return value style: boolean sub configureInternal { - my $self = assert_isa(shift, 'QtBuildSystem'); + my $self = assert_isa(shift, 'QMakeBuildSystem'); my $module = $self->module(); - my $srcdir = $module->fullpath('source'); - my $script = "$srcdir/configure"; + my $builddir = $module->fullpath('build'); + my $sourcedir = $module->fullpath('source'); + my @projectFiles = glob("$sourcedir/*.pro"); - if (! -e $script && !pretending()) - { - error ("\tMissing configure script for r[b[$module]"); - return 0; + if (!@projectFiles || !$projectFiles[0]) { + croak_internal("No *.pro files could be found for $module"); } - my @commands = split (/\s+/, $module->getOption('configure-flags')); - push @commands, '-confirm-license', '-opensource'; - - # Get the user's CXXFLAGS - my $cxxflags = $module->getOption('cxxflags'); - $module->buildContext()->queueEnvironmentVariable('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 (< 1) { + error (" b[r[*] Too many possible *.pro files for $module"); + return 0; } - push @commands, "-prefix", $prefix; - unshift @commands, $script; - - my $builddir = $module->fullpath('build'); - my $old_flags = $module->getPersistentOption('last-configure-flags') || ''; - my $cur_flags = main::get_list_digest(@commands); - - if(($cur_flags ne $old_flags) || - ($module->getOption('reconfigure')) || - (! -e "$builddir/Makefile") - ) - { - note ("\tb[r[LGPL license selected for Qt]. See $srcdir/LICENSE.LGPL"); - - info ("\tRunning g[configure]..."); - - $module->setPersistentOption('last-configure-flags', $cur_flags); - return log_command($module, "configure", \@commands) == 0; - } + p_chdir($builddir); - # Skip execution of configure. - return 1; + my $qmake = absPathToQMake(); + return 0 unless $qmake; + return log_command($module, 'qmake', [ $qmake, $projectFiles[0] ]) == 0; } 1; } # }}} -# package Module {{{ +# package l10nSystem {{{ { - package Module; + package l10nSystem; - use Storable 'dclone'; - use Carp 'confess'; - use Scalar::Util 'blessed'; - use overload - '""' => 'toString', # Add stringify operator. - '<=>' => 'compare', - ; + our @ISA = ('SvnUpdate', 'GenericBuildSystem'); ksb::Debug->import(); ksb::Util->import(); - # We will 'mixin' various backend-specific classes, e.g. GitUpdate or SvnUpdate - our @ISA = qw/GenericBuildSystem/; - - my $ModuleSource = 'config'; - sub new { - my ($class, $ctx, $name) = @_; - - 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 ($class, $module) = @_; - my $module = { - name => $name, - scm_obj => undef, - build_obj => undef, - phases => $phases, - context => $ctx, - options => $ctx->{build_options}{$name}, - 'module-set' => undef, - }; + # Ensure associated module updates from the proper svn path. + # TODO: Support different localization branches? - return bless $module, $class; + $module->setOption('module-base-path', 'trunk/l10n-kde4'); + return bless { module => $module, needsRefreshed => 1 }, $class; } - sub phases + sub module { my $self = shift; - return $self->{phases}; + return $self->{module}; } - sub moduleSet + sub configuredModuleFileName { - my ($self) = @_; - return $self->{'module-set'} if exists $self->{'module-set'}; - return ''; + # Not quite correct (we should be looking at each individual language + # but it at least keeps the process going. + return 'teamnames'; } - sub setModuleSet + # Sets the directories that are to be checked out/built/etc. + # There should be one l10nSystem for the entire l10n build (i.e. add + # all required support dirs and languages). + sub setLanguageDirs { - my ($self, $moduleSetName) = @_; - $self->{'module-set'} = $moduleSetName; + my ($self, @languageDirs) = @_; + $self->{l10n_dirs} = \@languageDirs; } - sub setModuleSource + # Returns true if the given subdirectory (reference from the module's root source directory) + # can be built or not. Should be reimplemented by subclasses as appropriate. + sub isSubdirBuildable { - my ($class, $source) = @_; - $ModuleSource = $source; + my ($self, $subdir) = @_; + return ($subdir ne 'scripts' && $subdir ne 'templates'); } - sub moduleSource + sub prefixEnvironmentVariable { - my $class = shift; - # Should be 'config' or 'cmdline'; - return $ModuleSource; + return 'CMAKE_PREFIX_PATH'; } - # Subroutine to retrieve a subdirectory path with tilde-expansion and - # relative path handling. - # The parameter is the option key (e.g. build-dir or log-dir) to read and - # interpret. - sub getSubdirPath + # scm-specific update procedure. + # May change the current directory as necessary. + sub updateInternal { - my ($self, $subdirOption) = @_; - my $dir = $self->getOption($subdirOption); - - # If build-dir starts with a slash, it is an absolute path. - return $dir if $dir =~ /^\//; + my $self = assert_isa(shift, 'UpdateHandler'); + my $module = $self->module(); + my $fullpath = $module->fullpath('source'); + my @dirs = @{$self->{l10n_dirs}}; - # Make sure we got a valid option result. - if (!$dir) { - confess ("Reading option for $subdirOption gave empty \$dir!"); - } + if (-e "$fullpath/.svn") { + $self->check_module_validity(); + my $count = $self->update_module_path(@dirs); - # If it starts with a tilde, expand it out. - if ($dir =~ /^~/) - { - $dir =~ s/^~/$ENV{'HOME'}/; + $self->{needsRefreshed} = 0 if $count == 0; + return $count; } - else - { - # Relative directory, tack it on to the end of $kdesrcdir. - my $kdesrcdir = $self->getOption('source-dir'); - $dir = "$kdesrcdir/$dir"; + else { + return $self->checkout_module_path(@dirs); } - - return $dir; - } - - # Do note that this returns the *base* path to the source directory, - # without the module name or kde_projects stuff appended. If you want that - # use subroutine fullpath(). - sub getSourceDir - { - my $self = shift; - return $self->getSubdirPath('source-dir'); } sub name { - my $self = shift; - return $self->{name}; + return 'l10n'; } - sub scm + # Returns a list of just the languages to install. + sub languages { - my $self = shift; - - return $self->{scm_obj} if $self->{scm_obj}; + my $self = assert_isa(shift, 'l10nSystem'); + my @langs = @{$self->{l10n_dirs}}; - # 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. + return grep { $self->isSubdirBuildable($_); } (@langs); + } - my $svn_status = $self->getOption('svn-server', 'module'); - my $repository = $self->getOption('repository', 'module') // ''; - my $rcfile = $self->buildContext()->rcFile(); + # Buildsystem support section - if ($svn_status && $repository) { - error (<{needsRefreshed}; + } - # Overload repository to allow bzr URLs? - if ($repository =~ /^bzr:\/\//) { - $self->{scm_obj} = BzrUpdate->new($self); - } + sub buildInternal + { + my $self = assert_isa(shift, 'l10nSystem'); + my $builddir = $self->module()->fullpath('build'); + my @langs = $self->languages(); + my $result = 0; - # If it needs a repo it's git. Everything else is svn for now. - $self->{scm_obj} //= - $repository - ? GitUpdate->new($self) - : SvnUpdate->new($self); + $result = (main::safe_make($self->module(), { + target => undef, + message => "Building localization for language...", + logbase => "build", + subdirs => \@langs, + }) == 0) || $result; - return $self->{scm_obj}; + return $result; } - sub setScmType + sub configureInternal { - my ($self, $scmType) = @_; + my $self = assert_isa(shift, 'l10nSystem'); - my $newType; + my $builddir = $self->module()->fullpath('build'); + my @langs = $self->languages(); + my $result = 0; - given($scmType) { - when('git') { $newType = GitUpdate->new($self); } - when('proj') { $newType = KDEProjectUpdate->new($self); } - when('metadata') { $newType = KDEProjectMetadataUpdate->new($self); } - when('l10n') { $newType = l10nSystem->new($self); } - when('svn') { $newType = SvnUpdate->new($self); } - when('bzr') { $newType = BzrUpdate->new($self); } - default { $newType = undef; } + for my $lang (@langs) { + my $prefix = $self->module()->installationPath(); + p_chdir("$builddir/$lang"); + + info ("\tConfiguring to build language $lang"); + $result = (log_command($self->module(), "cmake-$lang", + ['cmake', '-DCMAKE_INSTALL_PREFIX=' . $prefix]) == 0) || $result; } - $self->{scm_obj} = $newType; + return $result; } - # Returns a string describing the scm platform of the given module. - # Return value: 'git' or 'svn' at this point, as appropriate. - sub scmType + sub installInternal { - my $self = shift; - return $self->scm()->name(); + my $self = assert_isa(shift, 'l10nSystem'); + my $builddir = $self->module()->fullpath('build'); + my @langs = $self->languages(); + + return (main::safe_make($self->module(), { + target => 'install', + message => "Installing language...", + logbase => "install", + subdirs => \@langs, + }) == 0); } - sub currentScmRevision + # 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. + sub prepareFakeBuilddir { - my $self = shift; + my $self = assert_isa(shift, 'l10nSystem'); + my $module = $self->module(); + my $builddir = $module->fullpath('build'); + my $srcdir = $module->fullpath('source'); - return $self->scm()->currentRevisionInternal(); + # 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', 'main::safe_lndir', $srcdir, $builddir ]; + + info ("\tSetting up alternate build directory for l10n"); + return (0 == log_command ($module, 'create-builddir', $args)); } - sub buildSystem + # 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. + # + # Return convention: boolean (inherited) + sub createBuildSystem { - my $self = shift; + my $self = assert_isa(shift, 'l10nSystem'); + my $module = $self->module(); + my $builddir = $module->fullpath('build'); - if ($self->{build_obj} && $self->{build_obj}->name() ne 'generic') { - return $self->{build_obj}; + # l10n doesn't support srcdir != builddir, fake it. + whisper ("\tFaking builddir for g[$module]"); + if (!$self->prepareFakeBuilddir()) + { + error ("Error creating r[$module] build system!"); + return 0; } - # If not set, let's guess. - my $buildType; - my $sourceDir = $self->fullpath('source'); + p_chdir ($builddir); - if (($self->getOption('repository') =~ /gitorious\.org\/qt\//) || - ($self->getOption('repository') =~ /^kde:qt$/) || - (-e "$sourceDir/bin/syncqt")) - { - $buildType = QtBuildSystem->new($self); - } + my @langs = @{$self->{l10n_dirs}}; + @langs = grep { $self->isSubdirBuildable($_) } (@langs); - if (!$buildType && (-e "$sourceDir/CMakeLists.txt" || - $self->getOption('#xml-full-path'))) - { - $buildType = KDEBuildSystem->new($self); + foreach my $lang (@langs) { + my $cmd_ref = [ './scripts/autogen.sh', $lang ]; + if (log_command ($module, "build-system-$lang", $cmd_ref)) + { + error ("\tUnable to create build system for r[$module]"); + } } - if (!$buildType && (glob ("$sourceDir/*.pro"))) { - $buildType = QMakeBuildSystem->new($self); - } + $module->setOption('#reconfigure', 1); # Force reconfigure of the module - # 'configure' is a popular fall-back option even for other build - # systems so ensure we check last for autotools. - if (!$buildType && - (-e "$sourceDir/configure" || -e "$sourceDir/autogen.sh")) - { - croak_internal('The autotools build system is unsupported'); - } + return 1; + } - # Don't just assume the build system is KDE-based... - $buildType //= GenericBuildSystem->new($self); + 1; +} +# }}} - $self->{build_obj} = $buildType; +# package KDEBuildSystem {{{ +{ + package KDEBuildSystem; - return $self->{build_obj}; - } + ksb::Debug->import(); + ksb::Util->import(); - # Sets the build system **object**, although you can find the build system - # type afterwards (see buildSystemType). - sub setBuildSystem + our @ISA = ('GenericBuildSystem'); + + sub needsInstalled { - my ($self, $obj) = @_; + my $self = shift; - assert_isa($obj, 'GenericBuildSystem'); - $self->{build_obj} = $obj; + return 0 if $self->name() eq 'kde-common'; # Vestigial + return 1; } - # Current possible build system types: - # KDE (i.e. cmake), Qt, l10n (KDE language buildsystem), autotools (either - # configure or autogen.sh). A final possibility is 'pendingSource' which - # simply means that we don't know yet. - # - # If the build system type is not set ('pendingSource' counts as being - # set!) when this function is called then it will be autodetected if - # possible, but note that not all possible types will be detected this way. - # If in doubt use setBuildSystemType - sub buildSystemType + sub name { - my $self = shift; - return $self->buildSystem()->name(); + return 'KDE'; } - # Subroutine to build this module. - # Returns boolean false on failure, boolean true on success. - sub build + sub isProgressOutputSupported { - my $self = assert_isa(shift, 'Module'); - my $moduleName = $self->name(); - my $builddir = $self->fullpath('build'); - my $start_time = time; - my $buildSystem = $self->buildSystem(); + return 1; + } - if ($buildSystem->name() eq 'generic' && !pretending()) { - error ("\tr[b[$self] does not seem to have a build system to use."); - return 0; - } + sub prefixEnvironmentVariable + { + return 'CMAKE_PREFIX_PATH'; + } - return 0 if !$self->setupBuildSystem(); - return 1 if $self->getOption('build-system-only'); + sub requiredPrograms + { + return qw{cmake qmake}; + } - if (!$buildSystem->buildInternal()) - { - # Build failed + sub runTestsuite + { + my $self = assert_isa(shift, 'KDEBuildSystem'); + my $module = $self->module(); - my $elapsed = prettify_seconds (time - $start_time); + # Note that we do not run safe_make, which should really be called + # safe_compile at this point. - # Well we tried, but it isn't going to happen. - note ("\n\tUnable to build y[$self]!"); - info ("\tTook g[$elapsed]."); - return 0; + # 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'; } - else - { - my $elapsed = prettify_seconds (time - $start_time); - info ("\tBuild succeeded after g[$elapsed]."); - # TODO: This should be a simple phase to run. - if ($self->getOption('run-tests')) - { - $self->buildSystem()->runTestsuite(); + info ("\tRunning test suite..."); + + # Step 2: Run the tests. + my $numTests = -1; + my $countCallback = sub { + if ($_ && /([0-9]+) tests failed out of/) { + $numTests = $1; } + }; - # TODO: Likewise this should be a phase to run. - if ($self->getOption('install-after-build')) - { - my $ctx = $self->buildContext(); - main::handle_install($ctx, $self); + my $result = log_command($module, 'test-results', + [ 'make', $make_target ], + { callback => $countCallback, no_translate => 1}); + + if ($result != 0) { + if ($numTests > 0) { + warning ("\t$numTests tests failed for y[$module], consult latest/$module/test-results.log for info"); } - else - { - info ("\tSkipping install for y[$self]"); + else { + warning ("\tSome tests failed for y[$module], consult latest/$module/test-results.log for info"); } + + return 0; + } + else { + info ("\tAll tests ran successfully."); } return 1; } - # Subroutine to setup the build system in a directory. - # Returns boolean true on success, boolean false (0) on failure. - sub setupBuildSystem + sub configureInternal { - my $self = assert_isa(shift, 'Module'); - my $moduleName = $self->name(); - - my $buildSystem = $self->buildSystem(); + my $self = assert_isa(shift, 'KDEBuildSystem'); + my $module = $self->module(); - if ($buildSystem->name() eq 'generic' && !pretending()) { - croak_internal('Build system determination still pending when build attempted.'); + # Use cmake to create the build directory (sh script return value + # semantics). + if (main::safe_run_cmake ($module)) + { + error ("\tUnable to configure r[$module] with CMake!"); + return 0; } - if ($buildSystem->needsRefreshed()) - { - # 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[$self]."); + return 1; + } - # Check to see if we're actually supposed to go through the - # cleaning process. - if (!$self->getOption('#cancel-clean') && - !$buildSystem->cleanBuildSystem()) - { - warning ("\tUnable to clean r[$self]!"); - return 0; - } - } + 1; +} +# }}} - if (!$buildSystem->createBuildSystem()) { - error ("\tError creating r[$self]'s build system!"); - return 0; - } +# package QtBuildSystem {{{ +{ + package QtBuildSystem; - # Now we're in the checkout directory - # So, switch to the build dir. - # builddir is automatically set to the right value for qt - p_chdir ($self->fullpath('build')); + ksb::Debug->import(); + ksb::Util->import(); - if (!$buildSystem->configureInternal()) { - error ("\tUnable to configure r[$self] with " . $self->buildSystemType()); - return 0; - } + our @ISA = ('GenericBuildSystem'); - return 1; + sub needsInstalled + { + my $self = assert_isa(shift, 'QtBuildSystem'); + my $module = $self->module(); + return $module->getOption('qtdir') ne $module->fullpath('build'); } - # Responsible for installing the module (no update, build, etc.) - # Return value: Boolean flag indicating whether module installed successfully or - # not. - # Exceptions may be thrown for abnormal conditions (e.g. no build dir exists) - sub install + sub name { - my $self = assert_isa(shift, 'Module'); - my $builddir = $self->fullpath('build'); - my $buildSysFile = $self->buildSystem()->configuredModuleFileName(); - - if (!pretending() && ! -e "$builddir/$buildSysFile") - { - warning ("\tThe build system doesn't exist for r[$self]."); - warning ("\tTherefore, we can't install it. y[:-(]."); - return 0; - } + return 'Qt'; + } - $self->setupEnvironment(); + # If coming from gitorious.org instead of KDE's mirror we should force on + # progress output to work around a gitorious.org clone bug. + sub forceProgressOutput + { + my $self = assert_isa(shift, 'QtBuildSystem'); + my $module = $self->module(); - my @makeInstallOpts = split(' ', $self->getOption('make-install-prefix')); + return $module->getOption('repository') =~ /gitorious\.org\//; + } - # We can optionally uninstall prior to installing - # to weed out old unused files. - if ($self->getOption('use-clean-install') && - $self->getPersistentOption('last-install-rev')) - { - if (!$self->buildSystem()->uninstallInternal(@makeInstallOpts)) { - warning ("\tUnable to uninstall r[$self] before installing the new build."); - warning ("\tContinuing anyways..."); - } - else { - $self->unsetPersistentOption('last-install-rev'); - } - } + # Return value style: boolean + sub configureInternal + { + my $self = assert_isa(shift, 'QtBuildSystem'); + my $module = $self->module(); + my $srcdir = $module->fullpath('source'); + my $script = "$srcdir/configure"; - if (!$self->buildSystem()->installInternal(@makeInstallOpts)) + if (! -e $script && !pretending()) { - error ("\tUnable to install r[$self]!"); - $self->buildContext()->markModulePhaseFailed('install', $self); + error ("\tMissing configure script for r[b[$module]"); return 0; } - if (pretending()) - { - pretend ("\tWould have installed g[$self]"); - return 1; - } - - # Past this point we know we've successfully installed, for real. + my @commands = split (/\s+/, $module->getOption('configure-flags')); + push @commands, '-confirm-license', '-opensource'; - $self->setPersistentOption('last-install-rev', $self->currentScmRevision()); + # Get the user's CXXFLAGS + my $cxxflags = $module->getOption('cxxflags'); + $module->buildContext()->queueEnvironmentVariable('CXXFLAGS', $cxxflags); - my $remove_setting = $self->getOption('remove-after-install'); + my $prefix = $module->getOption('qtdir'); - # 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 = $self->fullpath('source'); - note ("\tRemoving b[r[$self source]."); - main::safe_rmtree($srcdir); - } + # Some users have added -prefix manually to their flags, they + # probably shouldn't anymore. :) - if($remove_setting eq 'builddir' || $remove_setting eq 'all') + if (scalar grep /^-prefix(=.*)?$/, @commands) { - # Remove builddir - note ("\tRemoving b[r[$self build directory]."); - main::safe_rmtree($builddir); + warning (<fullpath('build'); - my $buildSysFile = $self->buildSystem()->configuredModuleFileName(); + my $builddir = $module->fullpath('build'); + my $old_flags = $module->getPersistentOption('last-configure-flags') || ''; + my $cur_flags = main::get_list_digest(@commands); - if (!pretending() && ! -e "$builddir/$buildSysFile") + if(($cur_flags ne $old_flags) || + ($module->getOption('reconfigure')) || + (! -e "$builddir/Makefile") + ) { - warning ("\tThe build system doesn't exist for r[$self]."); - warning ("\tTherefore, we can't uninstall it."); - return 0; - } - - $self->setupEnvironment(); - - my @makeInstallOpts = split(' ', $self->getOption('make-install-prefix')); + note ("\tb[r[LGPL license selected for Qt]. See $srcdir/LICENSE.LGPL"); - if (!$self->buildSystem()->uninstallInternal(@makeInstallOpts)) - { - error ("\tUnable to uninstall r[$self]!"); - $self->buildContext()->markModulePhaseFailed('install', $self); - return 0; - } + info ("\tRunning g[configure]..."); - if (pretending()) - { - pretend ("\tWould have uninstalled g[$self]"); - return 1; + $module->setPersistentOption('last-configure-flags', $cur_flags); + return log_command($module, "configure", \@commands) == 0; } - $self->unsetPersistentOption('last-install-rev'); + # Skip execution of configure. return 1; } - sub buildContext - { - my $self = shift; - return $self->{context}; - } - - # Integrates 'set-env' option to the build context environment - sub applyUserEnvironment - { - my $self = assert_isa(shift, 'Module'); - my $ctx = $self->buildContext(); + 1; +} +# }}} - # Let's see if the user has set env vars to be set. - # Note the global set-env must be checked separately anyways, so - # we limit inheritance when searching. - my $env_hash_ref = $self->getOption('set-env', 'module'); +# package Module {{{ +{ + package Module; - while (my ($key, $value) = each %{$env_hash_ref}) - { - $ctx->queueEnvironmentVariable($key, $value); - } - } + use Storable 'dclone'; + use Carp 'confess'; + use Scalar::Util 'blessed'; + use overload + '""' => 'toString', # Add stringify operator. + '<=>' => 'compare', + ; - # Establishes proper build environment in the build context. Should be run - # before forking off commands for e.g. updates, builds, installs, etc. - sub setupEnvironment - { - my $self = assert_isa(shift, 'Module'); - my $ctx = $self->buildContext(); - my $kdedir = $self->getOption('kdedir'); - my $qtdir = $self->getOption('qtdir'); - my $prefix = $self->installationPath(); + ksb::Debug->import(); + ksb::Util->import(); - # Add global set-envs - $self->buildContext()->applyUserEnvironment(); + # We will 'mixin' various backend-specific classes, e.g. GitUpdate or SvnUpdate + our @ISA = qw/GenericBuildSystem/; - # Add some standard directories for pkg-config support. Include env settings. - my @pkg_config_dirs = ("$kdedir/lib/pkgconfig", "$qtdir/lib/pkgconfig"); - $ctx->prependEnvironmentValue('PKG_CONFIG_PATH', @pkg_config_dirs); + my $ModuleSource = 'config'; - # Likewise, add standard directories that should be in LD_LIBRARY_PATH. - my @ld_dirs = ("$kdedir/lib", "$qtdir/lib", $self->getOption('libpath')); - $ctx->prependEnvironmentValue('LD_LIBRARY_PATH', @ld_dirs); + sub new + { + my ($class, $ctx, $name) = @_; - my @path = ("$kdedir/bin", "$qtdir/bin", $self->getOption('binpath')); + confess "Empty Module constructed" unless $name; - if (my $prefixEnvVar = $self->buildSystem()->prefixEnvironmentVariable()) + # 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))) { - $ctx->prependEnvironmentValue($prefixEnvVar, $prefix); + confess "Invalid context $ctx"; } - $ctx->prependEnvironmentValue('PATH', @path); - - # Set up the children's environment. We use queueEnvironmentVariable since - # it won't set an environment variable to nothing. (e.g, setting QTDIR to - # a blank string might confuse Qt or KDE. - - $ctx->queueEnvironmentVariable('QTDIR', $qtdir); + # Clone the passed-in phases so we can be different. + my $phases = dclone($ctx->phases()) if $class eq 'Module'; - # If the module isn't kdelibs, also append kdelibs's KDEDIR setting. - if ($self->name() ne 'kdelibs') - { - my $kdelibsModule = $ctx->lookupModule('kdelibs'); - my $kdelibsDir; - $kdelibsDir = $kdelibsModule->installationPath() if $kdelibsModule; + # 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} //= { }; - if ($kdelibsDir && $kdelibsDir ne $kdedir) { - whisper ("Module $self uses different KDEDIR than kdelibs, including kdelibs as well."); - $kdedir .= ":$kdelibsDir" - } - } + my $module = { + name => $name, + scm_obj => undef, + build_obj => undef, + phases => $phases, + context => $ctx, + options => $ctx->{build_options}{$name}, + 'module-set' => undef, + }; - $ctx->queueEnvironmentVariable('KDEDIRS', $kdedir); + return bless $module, $class; + } - # Read in user environment defines - $self->applyUserEnvironment() unless $self->name() eq 'global'; + sub phases + { + my $self = shift; + return $self->{phases}; } - # 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 + sub moduleSet { my ($self) = @_; - return $self->buildContext()->getLogDirFor($self); + return $self->{'module-set'} if exists $self->{'module-set'}; + return ''; } - sub toString + sub setModuleSet { - my $self = shift; - return $self->name(); + my ($self, $moduleSetName) = @_; + $self->{'module-set'} = $moduleSetName; } - sub compare + sub setModuleSource { - my ($self, $other) = @_; - return $self->name() cmp $other->name(); + my ($class, $source) = @_; + $ModuleSource = $source; } - sub update + sub moduleSource { - my ($self, $ipc, $ctx) = @_; + my $class = shift; + # Should be 'config' or 'cmdline'; + return $ModuleSource; + } - my $moduleName = $self->name(); - my $module_src_dir = $self->getSourceDir(); - my $kdesrc = $ctx->getSourceDir(); + # Subroutine to retrieve a subdirectory path with tilde-expansion and + # relative path handling. + # The parameter is the option key (e.g. build-dir or log-dir) to read and + # interpret. + sub getSubdirPath + { + my ($self, $subdirOption) = @_; + my $dir = $self->getOption($subdirOption); - if ($kdesrc ne $module_src_dir) - { - # This module has a different source directory, ensure it exists. - if (!main::super_mkdir($module_src_dir)) - { - error ("Unable to create separate source directory for r[$self]: $module_src_dir"); - $ipc->sendIPCMessage(IPC::MODULE_FAILURE, $moduleName); - next; - } - } - - my $fullpath = $self->fullpath('source'); - my $count; - my $returnValue; + # If build-dir starts with a slash, it is an absolute path. + return $dir if $dir =~ /^\//; - eval { $count = $self->scm()->updateInternal() }; + # Make sure we got a valid option result. + if (!$dir) { + confess ("Reading option for $subdirOption gave empty \$dir!"); + } - if ($@) + # If it starts with a tilde, expand it out. + if ($dir =~ /^~/) { - if (ref $@ && $@->isa('BuildException')) { - $@ = $@->{'message'}; - } - - error ("Error updating r[$self], removing from list of packages to build."); - error (" > y[$@]"); - - my $reason = $self->getOption('#update-error'); - $reason = IPC::MODULE_FAILURE unless $reason; # Default error code - main::dont_build ($self, $ipc, $reason); # Sends IPC message. - $returnValue = 0; + $dir =~ s/^~/$ENV{'HOME'}/; } else { - my $message; - if (not defined $count) - { - $message = ksb_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."; - main::dont_build($self, $ipc, IPC::MODULE_UPTODATE); # Sends IPC message. - } + # Relative directory, tack it on to the end of $kdesrcdir. + my $kdesrcdir = $self->getOption('source-dir'); + $dir = "$kdesrcdir/$dir"; + } - # 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$self update complete, $message"); - } + return $dir; + } - $returnValue = 1; - } + # Do note that this returns the *base* path to the source directory, + # without the module name or kde_projects stuff appended. If you want that + # use subroutine fullpath(). + sub getSourceDir + { + my $self = shift; + return $self->getSubdirPath('source-dir'); + } - info (""); # Print empty line. - return $returnValue; + sub name + { + my $self = shift; + return $self->{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 module 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 + sub scm { - my ($self, $key, $levelLimit) = @_; - my $ctx = $self->buildContext(); - assert_isa($ctx, 'ksb::BuildContext'); - $levelLimit //= 'allow-inherit'; + my $self = shift; - # Some global options would probably make no sense applied to Qt. - my @qtCopyOverrides = qw(branch configure-flags tag cxxflags); - if (list_has(\@qtCopyOverrides, $key) && $self->buildSystemType() eq 'Qt') { - $levelLimit = 'module'; - } + return $self->{scm_obj} if $self->{scm_obj}; - assert_in($levelLimit, [qw(allow-inherit module)]); + # 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. - # If module-only, check that first. - return $self->{options}{$key} if $levelLimit eq 'module'; + my $svn_status = $self->getOption('svn-server', 'module'); + my $repository = $self->getOption('repository', 'module') // ''; + my $rcfile = $self->buildContext()->rcFile(); - # Some global options always override module options. - return $ctx->getOption($key) if $ctx->hasStickyOption($key); + if ($svn_status && $repository) { + error (<hasOption($key)) { - return $ctx->getOption($key) . " " . ($self->{options}{$key} || ''); +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')); } - # Everything else overrides the global option, unless it's simply not - # set at all. - return $self->{options}{$key} // $ctx->getOption($key); - } + # Overload repository to allow bzr URLs? + if ($repository =~ /^bzr:\/\//) { + $self->{scm_obj} = BzrUpdate->new($self); + } - # 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(); + # If it needs a repo it's git. Everything else is svn for now. + $self->{scm_obj} //= + $repository + ? GitUpdate->new($self) + : SvnUpdate->new($self); - return exists $self->{options}{$key}; + return $self->{scm_obj}; } - # 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 + sub setScmType { - 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 - } + my ($self, $scmType) = @_; - debug (" Setting $self,$key = $value"); - $self->{options}{$key} = $value; + my $newType; + + given($scmType) { + when('git') { $newType = GitUpdate->new($self); } + when('proj') { $newType = KDEProjectUpdate->new($self); } + when('metadata') { $newType = KDEProjectMetadataUpdate->new($self); } + when('l10n') { $newType = l10nSystem->new($self); } + when('svn') { $newType = SvnUpdate->new($self); } + when('bzr') { $newType = BzrUpdate->new($self); } + default { $newType = undef; } } - } - # Simply removes the given option and its value, if present - sub deleteOption - { - my ($self, $key) = @_; - delete $self->{options}{$key} if exists $self->{options}{$key}; + $self->{scm_obj} = $newType; } - # 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 + # Returns a string describing the scm platform of the given module. + # Return value: 'git' or 'svn' at this point, as appropriate. + sub scmType { - my ($self, $key) = @_; - return $self->buildContext()->getPersistentOption($self->name(), $key); + my $self = shift; + return $self->scm()->name(); } - # 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 + sub currentScmRevision { - my ($self, $key, $value) = @_; - return $self->buildContext()->setPersistentOption($self->name(), $key, $value); - } + my $self = shift; - # Unsets a persistent option for this module. - # Only parameter is the name of the option to unset. - sub unsetPersistentOption - { - my ($self, $key) = @_; - $self->buildContext()->unsetPersistentOption($self->name(), $key); + return $self->scm()->currentRevisionInternal(); } - # 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 + sub buildSystem { 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/]); + if ($self->{build_obj} && $self->{build_obj}->name() ne 'generic') { + return $self->{build_obj}; + } - my %pathinfo = main::get_module_path_dir($self, $type); - return $pathinfo{'fullpath'}; - } + # If not set, let's guess. + my $buildType; + my $sourceDir = $self->fullpath('source'); - # 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 is optional, but if provided will be used as the base - # path to replace $MODULE entries in dest-dir. - sub destDir - { - my $self = assert_isa(shift, 'Module'); - my $destDir = $self->getOption('dest-dir'); - my $basePath = shift // $self->getOption('#xml-full-path'); - $basePath ||= $self->name(); # Default if not provided in XML - - $destDir =~ s/(\${MODULE})|(\$MODULE\b)/$basePath/g; - - return $destDir; - } - - # Subroutine to return the installation path of a given module (the value - # that is passed to the CMAKE_INSTALL_PREFIX CMake option). - # It is based on the "prefix" and, if it is not set, the "kdedir" option. - # The user may use '$MODULE' or '${MODULE}' in the "prefix" option to have - # them replaced by the name of the module in question. - sub installationPath - { - my $self = assert_isa(shift, 'Module'); - my $path = $self->getOption('prefix'); - - if (!$path) + if (($self->getOption('repository') =~ /gitorious\.org\/qt\//) || + ($self->getOption('repository') =~ /^kde:qt$/) || + (-e "$sourceDir/bin/syncqt")) { - return $self->getOption('kdedir'); + $buildType = QtBuildSystem->new($self); } - my $moduleName = $self->name(); - $path =~ s/(\${MODULE})|(\$MODULE\b)/$moduleName/g; - - return $path; - } - + if (!$buildType && (-e "$sourceDir/CMakeLists.txt" || + $self->getOption('#xml-full-path'))) + { + $buildType = KDEBuildSystem->new($self); + } - 1; -} -# }}} + if (!$buildType && (glob ("$sourceDir/*.pro"))) { + $buildType = QMakeBuildSystem->new($self); + } -# package RecursiveFH {{{ -{ - package RecursiveFH; + # 'configure' is a popular fall-back option even for other build + # systems so ensure we check last for autotools. + if (!$buildType && + (-e "$sourceDir/configure" || -e "$sourceDir/autogen.sh")) + { + croak_internal('The autotools build system is unsupported'); + } - # Alias the global make_exception into this package. - *make_exception = *main::make_exception; + # Don't just assume the build system is KDE-based... + $buildType //= GenericBuildSystem->new($self); - sub new - { - my ($class) = @_; - my $data = { - 'filehandles' => [], # Stack of filehandles to read - 'current' => undef, # Current filehandle to read - }; + $self->{build_obj} = $buildType; - return bless($data, $class); + return $self->{build_obj}; } - sub addFilehandle + # Sets the build system **object**, although you can find the build system + # type afterwards (see buildSystemType). + sub setBuildSystem { - my ($self, $fh) = @_; - push @{$self->{filehandles}}, $fh; - $self->setCurrentFilehandle($fh); - } + my ($self, $obj) = @_; - sub popFilehandle - { - my $self = shift; - my $result = pop @{$self->{filehandles}}; - my $newFh = scalar @{$self->{filehandles}} ? ${$self->{filehandles}}[-1] - : undef; - $self->setCurrentFilehandle($newFh); - return $result; + assert_isa($obj, 'GenericBuildSystem'); + $self->{build_obj} = $obj; } - sub currentFilehandle + # Current possible build system types: + # KDE (i.e. cmake), Qt, l10n (KDE language buildsystem), autotools (either + # configure or autogen.sh). A final possibility is 'pendingSource' which + # simply means that we don't know yet. + # + # If the build system type is not set ('pendingSource' counts as being + # set!) when this function is called then it will be autodetected if + # possible, but note that not all possible types will be detected this way. + # If in doubt use setBuildSystemType + sub buildSystemType { my $self = shift; - return $self->{current}; + return $self->buildSystem()->name(); } - sub setCurrentFilehandle + # Subroutine to build this module. + # Returns boolean false on failure, boolean true on success. + sub build { - my $self = shift; - $self->{current} = shift; - } + my $self = assert_isa(shift, 'Module'); + my $moduleName = $self->name(); + my $builddir = $self->fullpath('build'); + my $start_time = time; + my $buildSystem = $self->buildSystem(); - # 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; + if ($buildSystem->name() eq 'generic' && !pretending()) { + error ("\tr[b[$self] does not seem to have a build system to use."); + return 0; + } - # Starts a loop so we can use evil things like "redo" - READLINE: { - my $line; - my $fh = $self->currentFilehandle(); + return 0 if !$self->setupBuildSystem(); + return 1 if $self->getOption('build-system-only'); - # Sanity check since different methods might try to read same file reader - return undef unless defined $fh; + if (!$buildSystem->buildInternal()) + { + # Build failed - if (eof($fh) || !defined($line = <$fh>)) { - my $oldFh = $self->popFilehandle(); - close $oldFh; + my $elapsed = prettify_seconds (time - $start_time); - my $fh = $self->currentFilehandle(); + # Well we tried, but it isn't going to happen. + note ("\n\tUnable to build y[$self]!"); + info ("\tTook g[$elapsed]."); + return 0; + } + else + { + my $elapsed = prettify_seconds (time - $start_time); + info ("\tBuild succeeded after g[$elapsed]."); - return undef if !defined($fh); + # TODO: This should be a simple phase to run. + if ($self->getOption('run-tests')) + { + $self->buildSystem()->runTestsuite(); + } - redo READLINE; + # TODO: Likewise this should be a phase to run. + if ($self->getOption('install-after-build')) + { + my $ctx = $self->buildContext(); + main::handle_install($ctx, $self); } - elsif ($line =~ /^\s*include\s+\S/) { - # Include found, extract file name and open file. - chomp $line; - my ($filename) = ($line =~ /^\s*include\s+(.+)$/); + else + { + info ("\tSkipping install for y[$self]"); + } + } - if (!$filename) { - die make_exception('Config', - "Unable to handle file include on line $., '$line'"); - } + return 1; + } - my $newFh; - $filename =~ s/^~\//$ENV{HOME}\//; # Tilde-expand + # Subroutine to setup the build system in a directory. + # Returns boolean true on success, boolean false (0) on failure. + sub setupBuildSystem + { + my $self = assert_isa(shift, 'Module'); + my $moduleName = $self->name(); - open ($newFh, '<', $filename) or - die make_exception('Config', - "Unable to open file $filename which was included from line $."); + my $buildSystem = $self->buildSystem(); - $self->addFilehandle($newFh); + if ($buildSystem->name() eq 'generic' && !pretending()) { + croak_internal('Build system determination still pending when build attempted.'); + } - redo READLINE; - } - else { - return $line; + if ($buildSystem->needsRefreshed()) + { + # 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[$self]."); + + # Check to see if we're actually supposed to go through the + # cleaning process. + if (!$self->getOption('#cancel-clean') && + !$buildSystem->cleanBuildSystem()) + { + warning ("\tUnable to clean r[$self]!"); + return 0; } } - } - 1; -} -# }}} + if (!$buildSystem->createBuildSystem()) { + error ("\tError creating r[$self]'s build system!"); + return 0; + } -# package DependencyResolver {{{ -{ - package DependencyResolver; + # Now we're in the checkout directory + # So, switch to the build dir. + # builddir is automatically set to the right value for qt + p_chdir ($self->fullpath('build')); - # This module handles resolving dependencies between modules. Each "module" - # from the perspective of this resolver is simply a module full name, as - # given by the KDE Project database. (e.g. extragear/utils/kdesrc-build) + if (!$buildSystem->configureInternal()) { + error ("\tUnable to configure r[$self] with " . $self->buildSystemType()); + return 0; + } - ksb::Debug->import(); - ksb::Util->import(); + return 1; + } - sub new + # Responsible for installing the module (no update, build, etc.) + # Return value: Boolean flag indicating whether module installed successfully or + # not. + # Exceptions may be thrown for abnormal conditions (e.g. no build dir exists) + sub install { - my $class = shift; - - my $self = { - # hash table mapping full module names (m) to a list reference - # containing the full module names of modules that depend on m. - dependenciesOf => { }, - }; - - return bless $self, $class; - } + my $self = assert_isa(shift, 'Module'); + my $builddir = $self->fullpath('build'); + my $buildSysFile = $self->buildSystem()->configuredModuleFileName(); - # Reads in dependency data in a psuedo-Makefile format. - # See kde-build-metadata/dependency-data. - # - # Object method. - # First parameter is the filehandle to read from. - sub readDependencyData - { - my $self = assert_isa(shift, 'DependencyResolver'); - my $fh = shift; + if (!pretending() && ! -e "$builddir/$buildSysFile") + { + warning ("\tThe build system doesn't exist for r[$self]."); + warning ("\tTherefore, we can't install it. y[:-(]."); + return 0; + } - my $dependenciesOfRef = $self->{dependenciesOf}; - my $dependencyAtom = - qr/ - ^\s* # Clear leading whitespace - ([^:\s]+) # Capture anything not a colon or whitespace (dependent item) - \s* # Clear whitespace we didn't capture - : - \s* - ([^\s]+) # Capture all non-whitespace (source item) - \s*$ # Ensure no trailing cruft. Any whitespace should end line - /x; # /x Enables extended whitespace mode + $self->setupEnvironment(); - while(my $line = <$fh>) { - # Strip comments, skip empty lines. - $line =~ s{#.*$}{}; - next if $line =~ /^\s*$/; + my @makeInstallOpts = split(' ', $self->getOption('make-install-prefix')); - if ($line !~ $dependencyAtom) { - croak_internal("Invalid line $line when reading dependency data."); + # We can optionally uninstall prior to installing + # to weed out old unused files. + if ($self->getOption('use-clean-install') && + $self->getPersistentOption('last-install-rev')) + { + if (!$self->buildSystem()->uninstallInternal(@makeInstallOpts)) { + warning ("\tUnable to uninstall r[$self] before installing the new build."); + warning ("\tContinuing anyways..."); } + else { + $self->unsetPersistentOption('last-install-rev'); + } + } - my ($dependentItem, $sourceItem) = $line =~ $dependencyAtom; - - # Initialize with array if not already defined. - $dependenciesOfRef->{$dependentItem} //= [ ]; + if (!$self->buildSystem()->installInternal(@makeInstallOpts)) + { + error ("\tUnable to install r[$self]!"); + $self->buildContext()->markModulePhaseFailed('install', $self); + return 0; + } - push @{$dependenciesOfRef->{$dependentItem}}, $sourceItem; + if (pretending()) + { + pretend ("\tWould have installed g[$self]"); + return 1; } - } - # Internal. - # This method is used to topographically sort dependency data. It accepts - # a Module, ensures that any KDE Projects it depends on are already on the - # build list, and then adds the Module to the build list (whether it is - # a KDE Project or not, to preserve ordering). - # - # Static method. - # First parameter: Reference to a hash of parameters. - # Second parameter: Module to "visit". Does not have to be a KDE Project. - # Return: Nothing. - sub _visitModuleAndDependencies - { - my ($optionsRef, $module) = @_; - assert_isa($module, 'Module'); + # Past this point we know we've successfully installed, for real. - my $visitedItemsRef = $optionsRef->{visitedItems}; - my $properBuildOrderRef = $optionsRef->{properBuildOrder}; - my $dependenciesOfRef = $optionsRef->{dependenciesOf}; - my $modulesFromNameRef = $optionsRef->{modulesFromName}; + $self->setPersistentOption('last-install-rev', $self->currentScmRevision()); - my $item = $module->getOption('#xml-full-path'); + my $remove_setting = $self->getOption('remove-after-install'); - if (!$item) { - push @{$properBuildOrderRef}, $module; - return; + # 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 = $self->fullpath('source'); + note ("\tRemoving b[r[$self source]."); + main::safe_rmtree($srcdir); } - debug ("dep-resolv: Visiting $item"); + if($remove_setting eq 'builddir' || $remove_setting eq 'all') + { + # Remove builddir + note ("\tRemoving b[r[$self build directory]."); + main::safe_rmtree($builddir); + } - $visitedItemsRef->{$item} //= 0; + return 1; + } - # This module may have already been added to build. - return if $visitedItemsRef->{$item} == 1; + # Handles uninstalling this module (or its sub-directories as given by the checkout-only + # option). + # + # Returns boolean false on failure, boolean true otherwise. + sub uninstall + { + my $self = assert_isa(shift, 'Module'); + my $builddir = $self->fullpath('build'); + my $buildSysFile = $self->buildSystem()->configuredModuleFileName(); - # But if the value is 2 that means we've detected a cycle. - if ($visitedItemsRef->{$item} > 1) { - croak_internal("Somehow there is a dependency cycle involving $item! :("); + if (!pretending() && ! -e "$builddir/$buildSysFile") + { + warning ("\tThe build system doesn't exist for r[$self]."); + warning ("\tTherefore, we can't uninstall it."); + return 0; } - $visitedItemsRef->{$item} = 2; # Mark as currently-visiting for cycle detection. - for my $subItem (@{$dependenciesOfRef->{$item}}) { - debug ("\tdep-resolv: $item depends on $subItem"); + $self->setupEnvironment(); - my $subModule = $modulesFromNameRef->{$subItem}; - if (!$subModule) { - note (" y[b[*] $module depends on $subItem, but no module builds $subItem for this run."); - next; - } + my @makeInstallOpts = split(' ', $self->getOption('make-install-prefix')); - _visitModuleAndDependencies($optionsRef, $subModule); + if (!$self->buildSystem()->uninstallInternal(@makeInstallOpts)) + { + error ("\tUnable to uninstall r[$self]!"); + $self->buildContext()->markModulePhaseFailed('install', $self); + return 0; } - $visitedItemsRef->{$item} = 1; # Mark as done visiting. - push @{$properBuildOrderRef}, $module; - return; + if (pretending()) + { + pretend ("\tWould have uninstalled g[$self]"); + return 1; + } + + $self->unsetPersistentOption('last-install-rev'); + return 1; } - # This method takes a list of Modules (real Module objects, not just module - # names). - # - # These modules have their dependencies resolved, and a new list of Modules - # is returned, containing the proper build order for the module given. - # - # Only "KDE Project" modules can be re-ordered or otherwise affect the - # build so this currently won't affect Subversion modules or "plain Git" - # modules. - # - # The dependency data must have been read in first (readDependencyData). - # - # Object method - # Parameters: Modules to evaluate, in suggested build order. - # Return: Modules to build, with any KDE Project modules in a valid - # ordering based on the currently-read dependency data. - sub resolveDependencies + sub buildContext { - my $self = assert_isa(shift, 'DependencyResolver'); - my @modules = @_; + my $self = shift; + return $self->{context}; + } - my $optionsRef = { - visitedItems => { }, - properBuildOrder => [ ], - dependenciesOf => $self->{dependenciesOf}, + # Integrates 'set-env' option to the build context environment + sub applyUserEnvironment + { + my $self = assert_isa(shift, 'Module'); + my $ctx = $self->buildContext(); - # will map names back to their Modules - modulesFromName => { - map { $_->getOption('#xml-full-path') => $_ } @modules - }, - }; + # Let's see if the user has set env vars to be set. + # Note the global set-env must be checked separately anyways, so + # we limit inheritance when searching. + my $env_hash_ref = $self->getOption('set-env', 'module'); - for my $module (@modules) { - _visitModuleAndDependencies($optionsRef, $module); + while (my ($key, $value) = each %{$env_hash_ref}) + { + $ctx->queueEnvironmentVariable($key, $value); } - - return @{$optionsRef->{properBuildOrder}}; } - 1; -} -# }}} - -# }}} + # Establishes proper build environment in the build context. Should be run + # before forking off commands for e.g. updates, builds, installs, etc. + sub setupEnvironment + { + my $self = assert_isa(shift, 'Module'); + my $ctx = $self->buildContext(); + my $kdedir = $self->getOption('kdedir'); + my $qtdir = $self->getOption('qtdir'); + my $prefix = $self->installationPath(); -# These packages are not in separate files so we must manually call import(). -ksb::Debug->import(); -ksb::Util->import(); + # Add global set-envs + $self->buildContext()->applyUserEnvironment(); -# 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 = { }; + # Add some standard directories for pkg-config support. Include env settings. + my @pkg_config_dirs = ("$kdedir/lib/pkgconfig", "$qtdir/lib/pkgconfig"); + $ctx->prependEnvironmentValue('PKG_CONFIG_PATH', @pkg_config_dirs); - # 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]"); + # Likewise, add standard directories that should be in LD_LIBRARY_PATH. + my @ld_dirs = ("$kdedir/lib", "$qtdir/lib", $self->getOption('libpath')); + $ctx->prependEnvironmentValue('LD_LIBRARY_PATH', @ld_dirs); - $pretendedMoves->{$oldDir}->{$newDir} = 1 if pretending(); - safe_system('mv', $oldDir, $newDir) == 0 or - croak_runtime("Unable to move directory $oldDir to $newDir"); - } + my @path = ("$kdedir/bin", "$qtdir/bin", $self->getOption('binpath')); - return 1; -} + if (my $prefixEnvVar = $self->buildSystem()->prefixEnvironmentVariable()) + { + $ctx->prependEnvironmentValue($prefixEnvVar, $prefix); + } -# 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 = $module->destDir(); - my $srcbase = $module->getSourceDir(); - $srcbase = $module->getSubdirPath('build-dir') if $type eq 'build'; + $ctx->prependEnvironmentValue('PATH', @path); - my $combined = "$srcbase/$destdir"; + # Set up the children's environment. We use queueEnvironmentVariable since + # it won't set an environment variable to nothing. (e.g, setting QTDIR to + # a blank string might confuse Qt or KDE. - # Remove dup // - $combined =~ s/\/+/\//; + $ctx->queueEnvironmentVariable('QTDIR', $qtdir); - my @parts = split(/\//, $combined); - my %result = (); - $result{'module'} = pop @parts; - $result{'path'} = join('/', @parts); - $result{'fullpath'} = "$result{path}/$result{module}"; + # If the module isn't kdelibs, also append kdelibs's KDEDIR setting. + if ($self->name() ne 'kdelibs') + { + my $kdelibsModule = $ctx->lookupModule('kdelibs'); + my $kdelibsDir; + $kdelibsDir = $kdelibsModule->installationPath() if $kdelibsModule; - my $compatDestDir = $module->destDir($module->name()); - my $fullCompatPath = "$srcbase/$compatDestDir"; + if ($kdelibsDir && $kdelibsDir ne $kdedir) { + whisper ("Module $self uses different KDEDIR than kdelibs, including kdelibs as well."); + $kdedir .= ":$kdelibsDir" + } + } - # 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); + $ctx->queueEnvironmentVariable('KDEDIRS', $kdedir); + + # Read in user environment defines + $self->applyUserEnvironment() unless $self->name() eq 'global'; + } + + # 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(); + } + + sub update + { + my ($self, $ipc, $ctx) = @_; + + my $moduleName = $self->name(); + my $module_src_dir = $self->getSourceDir(); + my $kdesrc = $ctx->getSourceDir(); + + if ($kdesrc ne $module_src_dir) + { + # This module has a different source directory, ensure it exists. + if (!main::super_mkdir($module_src_dir)) + { + error ("Unable to create separate source directory for r[$self]: $module_src_dir"); + $ipc->sendIPCMessage(IPC::MODULE_FAILURE, $moduleName); + next; + } } - elsif ($type eq 'build') { - # CMake doesn't like moving build directories, just destroy the - # old one. - state %warnedFor; - if (!$warnedFor{$fullCompatPath}) { - $warnedFor{$fullCompatPath} = 1; + my $fullpath = $self->fullpath('source'); + my $count; + my $returnValue; - 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."); - } - }; + eval { $count = $self->scm()->updateInternal() }; + + if ($@) + { + if (ref $@ && $@->isa('BuildException')) { + $@ = $@->{'message'}; + } + + error ("Error updating r[$self], removing from list of packages to build."); + error (" > y[$@]"); + + my $reason = $self->getOption('#update-error'); + $reason = IPC::MODULE_FAILURE unless $reason; # Default error code + main::dont_build ($self, $ipc, $reason); # Sends IPC message. + $returnValue = 0; } + else + { + my $message; + if (not defined $count) + { + $message = ksb_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."; + main::dont_build($self, $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$self update complete, $message"); + } + + $returnValue = 1; + } + + info (""); # Print empty line. + return $returnValue; } - return %result; -} + # 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 module 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'; -# 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; + # Some global options would probably make no sense applied to Qt. + my @qtCopyOverrides = qw(branch configure-flags tag cxxflags); + if (list_has(\@qtCopyOverrides, $key) && $self->buildSystemType() eq 'Qt') { + $levelLimit = 'module'; + } - my $ua = LWP::UserAgent->new(timeout => 30); + assert_in($levelLimit, [qw(allow-inherit module)]); - # Trailing space adds the appropriate LWP info since the resolver is not - # my custom coding anymore. - $ua->agent("kdesrc-build $versionNum "); + # If module-only, check that first. + return $self->{options}{$key} if $levelLimit eq 'module'; - whisper ("Downloading g[$filename] from g[$url]"); - my $response = $ua->mirror($url, $filename); + # 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); + } + + # Unsets a persistent option for this module. + # Only parameter is the name of the option to unset. + sub unsetPersistentOption + { + my ($self, $key) = @_; + $self->buildContext()->unsetPersistentOption($self->name(), $key); + } + + # 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'}; + } + + # 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 is optional, but if provided will be used as the base + # path to replace $MODULE entries in dest-dir. + sub destDir + { + my $self = assert_isa(shift, 'Module'); + my $destDir = $self->getOption('dest-dir'); + my $basePath = shift // $self->getOption('#xml-full-path'); + $basePath ||= $self->name(); # Default if not provided in XML - # LWP's mirror won't auto-convert "Unchanged" code to success, so check for - # both. - return 1 if $response->code == 304 || $response->is_success; + $destDir =~ s/(\${MODULE})|(\$MODULE\b)/$basePath/g; - error ("Failed to download y[b[$url] to b[$filename]"); - error ("Result was: y[b[" . $response->status_line . "]"); - return 0; -} + return $destDir; + } -# 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'); + # Subroutine to return the installation path of a given module (the value + # that is passed to the CMAKE_INSTALL_PREFIX CMake option). + # It is based on the "prefix" and, if it is not set, the "kdedir" option. + # The user may use '$MODULE' or '${MODULE}' in the "prefix" option to have + # them replaced by the name of the module in question. + sub installationPath + { + my $self = assert_isa(shift, 'Module'); + my $path = $self->getOption('prefix'); - if (!$branch && $module->getOption('use-stable-kde')) { - my $stable = $module->getOption('#branch:stable'); - if ($stable && $stable ne 'none') { - $branch = $stable; + if (!$path) + { + return $self->getOption('kdedir'); } - } - - $branch ||= 'master'; # If no branch, use 'master' - 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 $moduleName = $self->name(); + $path =~ s/(\${MODULE})|(\$MODULE\b)/$moduleName/g; - my $gitdir = $module->fullpath('source') . '/.git'; + return $path; + } - # Note that the --git-dir must come before the git command itself. - my ($id, undef) = filter_program_output( - undef, # No filter - qw/git --git-dir/, $gitdir, 'rev-parse', $commit, - ); - chomp $id if $id; - return $id; + 1; } +# }}} -# 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 +# package RecursiveFH {{{ { - my @args = @_; - - open(my $fh, '-|', @args); - my $count = 0; + package RecursiveFH; - $count++ while(<$fh>); - close $fh; - return $count; -} + # Alias the global make_exception into this package. + *make_exception = *main::make_exception; -# 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'); + sub new + { + my ($class) = @_; + my $data = { + 'filehandles' => [], # Stack of filehandles to read + 'current' => undef, # Current filehandle to read + }; - return 0 if $module->getOption('disable-snapshots'); - return 0 unless $tarball; + return bless($data, $class); + } - if (pretending()) { - pretend ("\tWould have downloaded snapshot for g[$module], from"); - pretend ("\tb[g[$tarball]"); - return 1; + sub addFilehandle + { + my ($self, $fh) = @_; + push @{$self->{filehandles}}, $fh; + $self->setCurrentFilehandle($fh); } - info ("\tDownloading git snapshot for g[$module]"); + sub popFilehandle + { + my $self = shift; + my $result = pop @{$self->{filehandles}}; + my $newFh = scalar @{$self->{filehandles}} ? ${$self->{filehandles}}[-1] + : undef; + $self->setCurrentFilehandle($newFh); + return $result; + } - my $filename = basename(URI->new($tarball)->path()); - my $tmpdir = File::Spec->tmpdir() // "/tmp"; - $filename = "$tmpdir/$filename"; # Make absolute + sub currentFilehandle + { + my $self = shift; + return $self->{current}; + } - if (!download_file($tarball, $filename)) { - error ("Unable to download snapshot for module r[$module]"); - return 0; + sub setCurrentFilehandle + { + my $self = shift; + $self->{current} = shift; } - info ("\tDownload complete, preparing module source code"); + # 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; - # 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); + if (eof($fh) || !defined($line = <$fh>)) { + my $oldFh = $self->popFilehandle(); + close $oldFh; - my $result = safe_system(qw(tar --strip-components 1 -C), - $sourceDir, '-xf', $filename); - my $savedError = $!; # Avoid interference from safe_unlink - safe_unlink ($filename); + my $fh = $self->currentFilehandle(); - if ($result) { - error ("Unable to extract snapshot for r[b[$module]: $savedError"); - safe_rmtree($sourceDir); - return 0; - } + 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+(.+)$/); - whisper ("\tg[$module] snapshot is in place"); + if (!$filename) { + die make_exception('Config', + "Unable to handle file include on line $., '$line'"); + } - # Complete the preparation by running the initrepo.sh script - p_chdir($sourceDir); - $result = log_command($module, 'init-git-repo', ['/bin/sh', './initrepo.sh']); + my $newFh; + $filename =~ s/^~\//$ENV{HOME}\//; # Tilde-expand - if ($result) { - error ("Snapshot for r[$module] extracted successfully, but failed to complete initrepo.sh"); - safe_rmtree($sourceDir); - return 0; - } + open ($newFh, '<', $filename) or + die make_exception('Config', + "Unable to open file $filename which was included from line $."); - whisper ("\tConverting to kde:-style URL"); - $result = log_command($module, 'fixup-git-remote', - ['git', 'remote', 'set-url', 'origin', "kde:$module"]); + $self->addFilehandle($newFh); - if ($result) { - warning ("\tUnable to convert origin URL to kde:-style URL. Things should"); - warning ("\tstill work, you may have to adjust push URL manually."); + redo READLINE; + } + else { + return $line; + } + } } - info ("\tGit snapshot installed, now bringing up to date."); - $result = log_command($module, 'init-git-pull', ['git', 'pull']); - return ($result == 0); + 1; } +# }}} -# 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 +# package DependencyResolver {{{ { - 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...) - if ($module->buildSystemType() eq 'Qt' && - $module->buildSystem()->forceProgressOutput()) - { - unshift (@args, '-v'); - } + package DependencyResolver; - note ("Cloning g[$module]"); + # This module handles resolving dependencies between modules. Each "module" + # from the perspective of this resolver is simply a module full name, as + # given by the KDE Project database. (e.g. extragear/utils/kdesrc-build) - # 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]); + ksb::Debug->import(); + ksb::Util->import(); - if ($result == 0) { - $module->setPersistentOption('git-cloned-repository', $git_repo); + sub new + { + my $class = shift; - my $branch = get_git_branch($module); + my $self = { + # hash table mapping full module names (m) to a list reference + # containing the full module names of modules that depend on m. + dependenciesOf => { }, + }; - # 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', $branch, "origin/$branch"]); - } + return bless $self, $class; } - return ($result == 0); -} + # Reads in dependency data in a psuedo-Makefile format. + # See kde-build-metadata/dependency-data. + # + # Object method. + # First parameter is the filehandle to read from. + sub readDependencyData + { + my $self = assert_isa(shift, 'DependencyResolver'); + my $fh = shift; -# 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; + my $dependenciesOfRef = $self->{dependenciesOf}; + my $dependencyAtom = + qr/ + ^\s* # Clear leading whitespace + ([^:\s]+) # Capture anything not a colon or whitespace (dependent item) + \s* # Clear whitespace we didn't capture + : + \s* + ([^\s]+) # Capture all non-whitespace (source item) + \s*$ # Ensure no trailing cruft. Any whitespace should end line + /x; # /x Enables extended whitespace mode - open my $output, '-|', qw(git remote); - my @remotes = grep { /^$remote/ } (<$output>); - close $output; + while(my $line = <$fh>) { + # Strip comments, skip empty lines. + $line =~ s{#.*$}{}; + next if $line =~ /^\s*$/; - return @remotes > 0; -} + if ($line !~ $dependencyAtom) { + croak_internal("Invalid line $line when reading dependency data."); + } -# We use a very-oddly-named remote name for the situations where we don't care -# about user interaction with git. However 99% of the time the 'origin' remote -# will be what we want anyways, and 0.5% of the rest the user will have -# manually added a remote, which we should try to utilize when doing checkouts -# for instance. To aid in this, this subroutine returns a list of all -# remote aliased matching the supplied repository (besides the internal -# alias that is). -# -# Assumes that we are already in the proper source directory. -# -# First parameter: Repository URL to match. -# Returns: A list of matching remote names (list in case the user hates us -# and has aliased more than one remote to the same repo). Obviously the list -# will be empty if no remote names were found. -sub git_get_best_remote_names -{ - my $repoUrl = shift; - my @outputs; + my ($dependentItem, $sourceItem) = $line =~ $dependencyAtom; - # 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 ./ - ); - }; + # Initialize with array if not already defined. + $dependenciesOfRef->{$dependentItem} //= [ ]; - if($@) { - error ("Unable to run git config, is there a setup error?"); - return (); + push @{$dependenciesOfRef->{$dependentItem}}, $sourceItem; + } } - my @results; - foreach my $output (@outputs) { - # git config output between key/val is divided by newline. - my ($remoteName, $url) = split(/\n/, $output); + # Internal. + # This method is used to topographically sort dependency data. It accepts + # a Module, ensures that any KDE Projects it depends on are already on the + # build list, and then adds the Module to the build list (whether it is + # a KDE Project or not, to preserve ordering). + # + # Static method. + # First parameter: Reference to a hash of parameters. + # Second parameter: Module to "visit". Does not have to be a KDE Project. + # Return: Nothing. + sub _visitModuleAndDependencies + { + my ($optionsRef, $module) = @_; + assert_isa($module, 'Module'); - $remoteName =~ s/^remote\.//; - $remoteName =~ s/\.url$//; # Extract the cruft + my $visitedItemsRef = $optionsRef->{visitedItems}; + my $properBuildOrderRef = $optionsRef->{properBuildOrder}; + my $dependenciesOfRef = $optionsRef->{dependenciesOf}; + my $modulesFromNameRef = $optionsRef->{modulesFromName}; - # Skip other remotes - next if $url ne $repoUrl; + my $item = $module->getOption('#xml-full-path'); - # Try to avoid "weird" remote names. - next if $remoteName !~ /^[\w-]*$/; + if (!$item) { + push @{$properBuildOrderRef}, $module; + return; + } - # A winner is this one. - push @results, $remoteName; - } + debug ("dep-resolv: Visiting $item"); - return @results; -} + $visitedItemsRef->{$item} //= 0; -# 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 local branch name will be equal to the remote branch name to match usual -# Git convention. -# * 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; - - # Use "$branch" directly if not already used, otherwise try - # to prefix with the best remote name or origin. - my $bestRemoteName = $remoteNamesRef ? $remoteNamesRef->[0] : 'origin'; - for my $possibleBranch ($branch, "$bestRemoteName-$branch", "origin-$branch") { - my @known_branches = eval { - # undef == no filter - filter_program_output(undef, 'git', 'branch', '--list', $possibleBranch) - }; + # This module may have already been added to build. + return if $visitedItemsRef->{$item} == 1; - # The desired branch name is OK as-is if no exceptions were thrown and - # the branch wasn't already known to git. - return $possibleBranch if !@known_branches && !$@; - } + # But if the value is 2 that means we've detected a cycle. + if ($visitedItemsRef->{$item} > 1) { + croak_internal("Somehow there is a dependency cycle involving $item! :("); + } - croak_runtime("Unable to find good branch name for $module branch name $branch"); -} + $visitedItemsRef->{$item} = 2; # Mark as currently-visiting for cycle detection. + for my $subItem (@{$dependenciesOfRef->{$item}}) { + debug ("\tdep-resolv: $item depends on $subItem"); -# 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; + my $subModule = $modulesFromNameRef->{$subItem}; + if (!$subModule) { + note (" y[b[*] $module depends on $subItem, but no module builds $subItem for this run."); + next; + } - # Dereference our remote names. - my @remoteNames = @{$remoteNamesRef}; + _visitModuleAndDependencies($optionsRef, $subModule); + } - # 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. + $visitedItemsRef->{$item} = 1; # Mark as done visiting. + push @{$properBuildOrderRef}, $module; + return; + } - my @branches = slurp_git_config_output( - qw/git config --null --get-regexp branch\..*\.remote/, $remoteName - ); + # This method takes a list of Modules (real Module objects, not just module + # names). + # + # These modules have their dependencies resolved, and a new list of Modules + # is returned, containing the proper build order for the module given. + # + # Only "KDE Project" modules can be re-ordered or otherwise affect the + # build so this currently won't affect Subversion modules or "plain Git" + # modules. + # + # The dependency data must have been read in first (readDependencyData). + # + # Object method + # Parameters: Modules to evaluate, in suggested build order. + # Return: Modules to build, with any KDE Project modules in a valid + # ordering based on the currently-read dependency data. + sub resolveDependencies + { + my $self = assert_isa(shift, 'DependencyResolver'); + my @modules = @_; - 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$/); + my $optionsRef = { + visitedItems => { }, + properBuildOrder => [ ], + dependenciesOf => $self->{dependenciesOf}, - # 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" - ); + # will map names back to their Modules + modulesFromName => { + map { $_->getOption('#xml-full-path') => $_ } @modules + }, + }; - if(@configOutput && $configOutput[0] eq "refs/heads/$branchName") { - # We have a winner - return $thisBranch; - } + for my $module (@modules) { + _visitModuleAndDependencies($optionsRef, $module); } + + return @{$optionsRef->{properBuildOrder}}; } - return ''; + 1; } +# }}} -# 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) { - croak_runtime("$module doesn't appear to be a git module."); - } - - 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) { - croak_runtime("$module doesn't appear to be a git module."); - } - 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) { - croak_runtime("Unable to stash local changes for $module, aborting update."); - } - } +# These packages are not in separate files so we must manually call import(). +ksb::Debug->import(); +ksb::Util->import(); - $status = log_command($module, 'git-pull-rebase', [ - qw(git pull --rebase --quiet) - ]); +# 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 = { }; - if ($status != 0) { - error ("Unable to update the source code for r[b[$module]"); - return 0; - } + # 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]"); - # 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 (<{$oldDir}->{$newDir} = 1 if pretending(); + safe_system('mv', $oldDir, $newDir) == 0 or + croak_runtime("Unable to move directory $oldDir to $newDir"); } 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 +# 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 $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] (to branch b[$branch])"); - 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); + my $type = shift; + my $destdir = $module->destDir(); + my $srcbase = $module->getSourceDir(); + $srcbase = $module->getSubdirPath('build-dir') if $type eq 'build'; - 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"; - } + my $combined = "$srcbase/$destdir"; - push @remoteNames, GIT_REMOTE_ALIAS; - } + # Remove dup // + $combined =~ s/\/+/\//; - if ($old_repo and ($cur_repo ne $old_repo)) { - note (" y[b[*]\ty[$module]'s selected repository has changed"); - note (" y[b[*]\tfrom y[$old_repo]"); - note (" y[b[*]\tto b[$cur_repo]"); - note (" y[b[*]\tThe git remote named b[", GIT_REMOTE_ALIAS, "] has been updated"); + my @parts = split(/\//, $combined); + my %result = (); + $result{'module'} = pop @parts; + $result{'path'} = join('/', @parts); + $result{'fullpath'} = "$result{path}/$result{module}"; - # Update what we think is the current repository on-disk. - $module->setPersistentOption('git-cloned-repository', $cur_repo); - } + my $compatDestDir = $module->destDir($module->name()); + my $fullCompatPath = "$srcbase/$compatDestDir"; - # 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"; - } + # 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; - # 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 (!$warnedFor{$fullCompatPath}) { + $warnedFor{$fullCompatPath} = 1; - 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"; + 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."); + } + }; } } - # 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"; - } + return %result; } -# Either performs the initial checkout or updates the current git checkout for -# git-using modules, as appropriate. -# -# If errors are encountered, an exception is raised using die(). +# 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 # -# Returns the number of files updated (actually it just returns 0 now, but maybe someday) -sub update_module_git_checkout +# 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 $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 (<getOption('repository'); + my $ua = LWP::UserAgent->new(timeout => 30); - if (not $git_repo) { - die "Unable to checkout $module, you must specify a repository to use."; - } + # Trailing space adds the appropriate LWP info since the resolver is not + # my custom coding anymore. + $ua->agent("kdesrc-build $versionNum "); - git_clone_module($module, "$git_repo") or die "Can't checkout $module: $!"; + whisper ("Downloading g[$filename] from g[$url]"); + my $response = $ua->mirror($url, $filename); - return 1 if pretending(); - return count_command_output('git', '--git-dir', "$srcdir/.git", 'ls-files'); - } + # LWP's mirror won't auto-convert "Unchanged" code to success, so check for + # both. + return 1 if $response->code == 304 || $response->is_success; + error ("Failed to download y[b[$url] to b[$filename]"); + error ("Result was: y[b[" . $response->status_line . "]"); return 0; } @@ -6834,19 +6904,6 @@ sub handle_set_env return 1; } -# A simple wrapper that is used to split the output of 'git config --null' -# correctly. All parameters are then passed to filter_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 = filter_program_output(undef, @_)); # No filter - return @output; -} - # 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 @@ -7370,49 +7427,6 @@ EOF 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 @@ -7453,7 +7467,7 @@ sub handle_updates } if (grep { $_->scm()->isa('GitUpdate') } @update_list) { - verifyGitConfig(); + GitUpdate::verifyGitConfig(); } note ("<<< Updating Source Directories >>>");