diff --git a/kdesrc-build b/kdesrc-build index 5149c0c..e2b79eb 100755 --- a/kdesrc-build +++ b/kdesrc-build @@ -1,396 +1,396 @@ #!/usr/bin/env perl # Script to handle building KDE from source code. All of the configuration is # stored in the file ./kdesrc-buildrc (or ~/.kdesrc-buildrc, if that's not # present). # # Please also see the documentation that should be included with this program, # in the doc/ directory. # # Copyright © 2003 - 2018 Michael Pyne. # Home page: https://kdesrc-build.kde.org/ # # Copyright © 2005, 2006, 2008 - 2011 David Faure # Copyright © 2005 Thiago Macieira # Copyright © 2006 Stephan Kulow # Copyright © 2006, 2008 Dirk Mueller # ... and possibly others. Check the git source repository for specifics. # # This program is free software; you can redistribute it and/or modify it under # the terms of the GNU General Public License as published by the Free Software # Foundation; either version 2 of the License, or (at your option) any later # version. # # This program is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more # details. # # You should have received a copy of the GNU General Public License along with # this program; if not, write to the Free Software Foundation, Inc., 51 # Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # Adding an option? Grep for 'defaultGlobalOptions' in ksb::BuildContext --mpyne use 5.014; # Require Perl 5.14 use strict; use warnings; # On many container-based distros, even FindBin is missing to conserve space. # But we can use File::Spec to do nearly the same. my $RealBin; my $modPath; # The File::Spec calls have to run when parsing (i.e. in BEGIN) to make the # 'use lib' below work (which itself implicitly uses BEGIN { }) BEGIN { use File::Spec; # resolve symlinks my $scriptPath = $0; for (1..16) { last unless -l $scriptPath; $scriptPath = readlink $scriptPath; } die "Too many symlinks followed looking for script" if -l $scriptPath; my ($volume, $directories, $script) = File::Spec->splitpath($scriptPath); $RealBin = File::Spec->catpath($volume, $directories, ''); die "Couldn't find base directory!" unless $RealBin; # Use modules in git repo if running from git dir, otherwise assume # system install $modPath = File::Spec->rel2abs('modules', $RealBin); $modPath = ($RealBin =~ s,/bin/?$,/share/kdesrc-build/modules,r) unless -d $modPath; die "Couldn't find modules for kdesrc-build!" unless $modPath; } use lib "$modPath"; # Make ksb:: modules available sub dumpError { my $err = $@; open my $fh, '>>', "error-$$.log" or return; my $time = localtime; say $fh $time; say $fh $@; } # When running in a limited environment, we might not be able to load # our modules although we can find them. In this case we should help user # by setting up system dependencies. eval { if (grep { $_ eq '--initial-setup' } @ARGV) { require ksb::FirstRun; require ksb::Debug; ksb::Debug::setColorfulOutput(1); - exit ksb::FirstRun::setupUserSystem($RealBin); + exit ksb::FirstRun::setupUserSystem(File::Spec->rel2abs($RealBin)); } }; if ($@) { dumpError(); say STDERR <import(); ksb::Util->import(); ksb::BuildException->import(); ksb::Version->import(qw(scriptVersion)); ksb::Application->import(); # Make Perl 'plain die' exceptions use Carp::confess instead of their core # support. This is not supported by the Perl 5 authors but assuming it works # will be better than the alternative backtrace we get (which is to say, none) $SIG{__DIE__} = \&Carp::confess; ksb::Version->path($RealBin); ### Script-global functions. # These functions might be called at runtime via log_command, using # log_command's support for symbolic execution of a named subroutine. Because # of that, they have been left in the top-level script. # # Everything else should be in an appropriate class. # Subroutine to recursively symlink a directory into another location, in a # similar fashion to how the XFree/X.org lndir() program does it. This is # reimplemented here since some systems lndir doesn't seem to work right. # # Used from ksb::l10nSystem # # As a special exception to the GNU GPL, you may use and redistribute this # function however you would like (i.e. consider it public domain). # # The first parameter is the directory to symlink from. # The second parameter is the destination directory name. # # e.g. if you have $from/foo and $from/bar, lndir would create $to/foo and # $to/bar. # # All intervening directories will be created as needed. In addition, you # may safely run this function again if you only want to catch additional files # in the source directory. # # Note that this function will unconditionally output the files/directories # created, as it is meant to be a close match to lndir. # # RETURN VALUE: Boolean true (non-zero) if successful, Boolean false (0, "") # if unsuccessful. sub safe_lndir { my ($from, $to) = @_; # Create destination directory. if (not -e $to) { print "$to\n"; if (not pretending() and not super_mkdir($to)) { error ("Couldn't create directory r[$to]: b[r[$!]"); return 0; } } # Create closure callback subroutine. my $wanted = sub { my $dir = $File::Find::dir; my $file = $File::Find::fullname; $dir =~ s/$from/$to/; # Ignore the .svn directory and files. return if $dir =~ m,/\.svn,; # Create the directory. if (not -e $dir) { print "$dir\n"; if (not pretending()) { super_mkdir ($dir) or croak_runtime("Couldn't create directory $dir: $!"); } } # Symlink the file. Check if it's a regular file because File::Find # has no qualms about telling you you have a file called "foo/bar" # before pointing out that it was really a directory. if (-f $file and not -e "$dir/$_") { print "$dir/$_\n"; if (not pretending()) { symlink $File::Find::fullname, "$dir/$_" or croak_runtime("Couldn't create file $dir/$_: $!"); } } }; # Recursively descend from source dir using File::Find eval { find ({ 'wanted' => $wanted, 'follow_fast' => 1, 'follow_skip' => 2}, $from); }; if ($@) { error ("Unable to symlink $from to $to: $@"); return 0; } return 1; } # Subroutine to delete recursively, everything under the given directory, # unless we're in pretend mode. # # Used from ksb::BuildSystem to handle cleaning a build directory. # # i.e. the effect is similar to "rm -r $arg/* $arg/.*". # # This assumes we're called from a separate child process. Therefore the # normal logging routines are /not used/, since our output will be logged # by the parent kdesrc-build. # # The first parameter should be the absolute path to the directory to delete. # # Returns boolean true on success, boolean false on failure. sub prune_under_directory { my $dir = shift; my $errorRef; print "starting delete of $dir\n"; eval { remove_tree($dir, { keep_root => 1, error => \$errorRef }); }; if ($@ || @$errorRef) { error ("\tUnable to clean r[$dir]:\n\ty[b[$@]"); return 0; } return 1; } sub findMissingModules { # should be either strings of module names to be found or a listref containing # a list of modules where any one of which will work. my @requiredModules = ( 'HTTP::Tiny', 'IO::Socket::SSL', [qw(JSON::XS JSON::PP)], [qw(YAML::XS YAML::PP YAML::Syck)] ); my @missingModules; my $validateMod = sub { return eval "require $_[0]; 1;"; }; my $description; foreach my $neededModule (@requiredModules) { if (ref $neededModule) { # listref of options my @moduleOptions = @$neededModule; next if (ksb::Util::any (sub { $validateMod->($_); }, $neededModule)); $description = 'one of (' . join(', ', @moduleOptions) . ')'; } else { next if $validateMod->($neededModule); $description = $neededModule; } push @missingModules, $description; } return @missingModules; } # Script starts. # Ensure some critical Perl modules are available so that the user isn't surprised # later with a Perl exception if(my @missingModuleDescriptions = findMissingModules()) { say <new(@ARGV); push @atexit_subs, sub { $app->finish(99) }; my $result = $app->runAllModulePhases(); @atexit_subs = (); # Clear exit handlers $app->finish($result); }; if (my $err = $@) { if (had_an_exception()) { print "kdesrc-build encountered an exceptional error condition:\n"; print " ========\n"; print " $err\n"; print " ========\n"; print "\tCan't continue, so stopping now.\n"; if ($err->{'exception_type'} eq 'Internal') { print "\nPlease submit a bug against kdesrc-build on https://bugs.kde.org/\n" } } else { # We encountered an error. print "Encountered an error in the execution of the script.\n"; print "The error reported was $err\n"; print "Please submit a bug against kdesrc-build on https://bugs.kde.org/\n"; } exit 99; } # vim: set et sw=4 ts=4 fdm=marker: