diff --git a/kdesrc-build b/kdesrc-build index 54dc1b3..d65aaa6 100755 --- a/kdesrc-build +++ b/kdesrc-build @@ -1,264 +1,314 @@ #!/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 - 2017 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 FindBin qw($RealBin); use lib "$RealBin/../share/apps/kdesrc-build/modules"; use lib "$RealBin/modules"; # Force all symbols to be in this package. We can tell if we're being called # through require/eval/etc. by using the "caller" function. package main; use strict; use warnings; use Carp; use Data::Dumper; use File::Find; # For our lndir reimplementation. use File::Path qw(remove_tree); +use List::Util qw(any); use ksb::Debug; use ksb::Util; use ksb::Version qw(scriptVersion); use ksb::Application; use 5.014; # Require Perl 5.14 # 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::SCRIPT_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 (List::Util::any { $validateMod->($_); } @moduleOptions); + $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); # Hack for debugging current state. if (exists $ENV{KDESRC_BUILD_DUMP_CONTEXT}) { local $Data::Dumper::Indent = 1; local $Data::Dumper::Sortkeys = 1; # This method call dumps the first list with the variables named by the # second list. print Data::Dumper->Dump([$app->context()], [qw(ctx)]); } 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: