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

# 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(File::Spec->rel2abs($RealBin));
    }
};

if ($@) {
    dumpError();
    say STDERR <<DONE;
* Unable to even load the simplistic initial setup support for some reason??

More detail might be available in error-$$.log

You could:
 File a bug https://bugs.kde.org/enter_bug.cgi?product=kdesrc-build
 Ask for help on Freenode IRC in the #kde channel
DONE
    exit 1;
}

# Even though the flow of execution should not make it here unless the modules
# we need are installed, we still cannot "use" the modules that might be
# missing on first use since just trying to parse/compile the code is then
# enough to cause errors.
eval {
    use Carp;
    use File::Find; # For our lndir reimplementation.
    use File::Path qw(remove_tree);

    require ksb::Debug;
    require ksb::Util;
    require ksb::Version;
    require ksb::Application;
    require ksb::BuildException;
};

if ($@) {
    dumpError();
    say STDERR <<DONE;
Couldn't load the base platform for kdesrc-build!
More detail might be available in error-$$.log
DONE

    if (! -e "kdesrc-buildrc" && ! -e "$ENV{HOME}/.kdesrc-buildrc") {
        say STDERR <<DONE;
It appears you've not run kdesrc-build before.

Please run "kdesrc-build --initial-setup" and kdesrc-build will guide you
through setting up required dependencies and environment setup.
DONE
    }
    exit 1;
}

ksb::Debug->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 <<EOF;
kdesrc-build requires some minimal support to operate, including support
from the Perl runtime that kdesrc-build is built upon.

Some mandatory Perl modules are missing, and kdesrc-build cannot operate
without them.  Please ensure these modules are installed and available to Perl:
EOF
    say "\t$_" foreach @missingModuleDescriptions;

    say "\nkdesrc-build can do this for you on many distros:";
    say "Run 'kdesrc-build --initial-setup'";

    # TODO: Built-in mapping to popular distro package names??
    exit 1;
}

# Adding in a way to load all the functions without running the program to
# enable some kind of automated QA testing.
if (defined caller && caller eq 'test')
{
    my $scriptVersion = scriptVersion();
    say "kdesrc-build being run from testing framework, BRING IT.";
    say "kdesrc-build is version $scriptVersion";
    return 1;
}

my $app;
our @atexit_subs;

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

# Use some exception handling to avoid ucky error messages
eval
{
    $app = ksb::Application->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:
