#!/usr/bin/perl
#############################################################################
##
## Copyright (C) 2012 Nokia Corporation and/or its subsidiary(-ies).
## Contact: http://www.qt-project.org/
##
## This file is part of the utilities of the Qt Toolkit.
##
## $QT_BEGIN_LICENSE:LGPL$
## GNU Lesser General Public License Usage
## This file may be used under the terms of the GNU Lesser General Public
## License version 2.1 as published by the Free Software Foundation and
## appearing in the file LICENSE.LGPL included in the packaging of this
## file. Please review the following information to ensure the GNU Lesser
## General Public License version 2.1 requirements will be met:
## http://www.gnu.org/licenses/old-licenses/lgpl-2.1.html.
##
## In addition, as a special exception, Nokia gives you certain additional
## rights. These rights are described in the Nokia Qt LGPL Exception
## version 1.1, included in the file LGPL_EXCEPTION.txt in this package.
##
## GNU General Public License Usage
## Alternatively, this file may be used under the terms of the GNU General
## Public License version 3.0 as published by the Free Software Foundation
## and appearing in the file LICENSE.GPL included in the packaging of this
## file. Please review the following information to ensure the GNU General
## Public License version 3.0 requirements will be met:
## http://www.gnu.org/copyleft/gpl.html.
##
## Other Usage
## Alternatively, this file may be used in accordance with the terms and
## conditions contained in a signed written agreement between you and Nokia.
##
##
##
##
##
##
## $QT_END_LICENSE$
##
#############################################################################

use v5.008;
use strict;
use warnings;

package Qt::Build;

=head1 NAME

build - builds the Qt5 repository with all submodules in order

=head1 SYNOPSIS

B<build> [B<-v>|B<--verbose> [n]] [B<-c>|B<--continue> [n]] [B<-j>|B<--jobs> [n]] [B<-n>|B<--dry-run> [n]] [B<--force-qmake>] [modules to build]

=head1 DESCRIPTION

This script is used to build all the Qt modules in the correct order. The way of building the Qt
modules is fairly complex, since they need to both be built and installed in the proper order, if
configured prefix happens to be in a different location than the build directory of QtBase.

It's not enough to do first a top-level 'make', then a 'make install', since modules would then no
be available to the consecutive modules. The build script also handles a situation where Jom
exposes a dependency bug with parallel builds, by doing a 'qmake -r' on each individual module as
part of each modules build process.

If no modules to build are passed on the command-line, all the default modules will be built.

=head1 OPTIONS

=over

=item  B<-v> [n], B<--verbose> [n]

Makes output more verbose. Level of verboseness optional (default: 1).

=item B<-c> [n], B<--continue> [n]

Ignore failed submodules, and continue building. Continue has levels (default: 1). The default
level will make the build script ignore any errors in a submodule, and continue to build the next
dependency. Level 2 means that the --keep-going option is also passed to make for each submodule.

=item B<-j> [n], B<--jobs> [n]

Sets the number of parallel builds. Number is optional, but providing no number indicates
Unlimited, which you most likely do not want.

=item B<--force-qmake>

Forces a 'qmake -r' on a module, even if the build script detects an already existing Makefile in
the module.

=item B<-n> [n], B<--dry-run> [n]

Does a dry-run, show which actions will be taken without actually performing them. Dry-run has
levels (default: 1). The default level only shows which commands this script will execute. Level 2
will also do a dry-run on make, showing all the actions the build-script will result in. Level 2
requires C<qmake -r> to run, so it is not completely "dry" in its purest sense, although nothing is
built.

=back

=head1 COPYRIGHT

Copyright (C) 2012 Nokia Corporation and/or its subsidiary(-ies).
Contact: http://www.qt-project.org/

=head1 LICENSE

This file is part of the utilities of the Qt Toolkit, and may be used under the terms of the GNU
Lesser General Public (LGPL 2.1), or the GNU General Public License (GPL 3.0)

=cut

use Carp         qw( confess             );
use English      qw( -no_match_vars      );
use Getopt::Long qw( GetOptionsFromArray );
use Pod::Usage   qw( pod2usage           );
use Cwd          qw( getcwd              );
use File::Spec   qw( path catfile        );
use Config;

sub parse_arguments
{
    my ($self, @args) = @_;

    %{$self} = (%{$self},
        'verbose'             => 0,
        'continue'            => 0,
        'jobs'                => -1,
        'force_qmake'         => 0,
        'build-submodules'    => [],
        'dry-run'             => 0,
    );

    GetOptionsFromArray(\@args,
        'verbose|v:1'   =>  \$self->{'verbose'},
        'continue|c:1'  =>  \$self->{'continue'},
        'jobs|j:0'      =>  \$self->{'jobs'},
        'force-qmake'   =>  \$self->{'force_qmake'},
        'dry-run|n:1'   =>  \$self->{'dry-run'},
        'help|?'        =>  sub { pod2usage(1); },
    ) || pod2usage(2);

    push(@{$self->{'build-submodules'}}, @args) if (@args);

    return;
}

# Like `system', but possibly log the command, and die on non-zero exit code
sub exe
{
    my ($self, @cmd) = @_;

    print "+ @cmd\n" unless ($self->{quiet});

    # dry-run > 1 means run sub-processes with dry-run too
    if ($self->{'dry-run'} != 1) {
        confess "@cmd exited with status $CHILD_ERROR" if (system(@cmd) != 0);
    }
}

sub dropPrivileges()
{
    my ($self) = @_;

    if ($> == 0) { # EUID == 0: must drop if possible
        local $! = undef;
        if ($< != 0) { # UID != 0 (run through setuid). swap UID with EUID
            ($(, $)) = ($), $();
            die "Cannot lower gid privileges: $!" if $!;
            ($<, $>) = ($>, $<);
            die "Cannot lower uid privileges: $!" if $!;
        } else { # UID == 0: run through sudo?
            if (defined $ENV{SUDO_GID}) {
                $) = "$ENV{SUDO_GID} $ENV{SUDO_GID}";
                die "Cannot lower gid privileges: $!" if $!;
            }
            if (defined $ENV{SUDO_UID}) {
                $> = $ENV{SUDO_UID};
                die "Cannot lower uid privileges: $!" if $!;
            }
        }
    }
}

sub exeHighPriv()
{
    my ($self, @cmd) = @_;
    # confesses upon system() failure
    $self->exe(@cmd);
}

sub exeLowPriv()
{
    my ($self, @cmd) = @_;

    if ("$Config{osname}" !~ /mswin/i) {
        my $ret;
        my $pid = fork();
        die "Couldn't fork" unless defined $pid;
        if ($pid == 0) {
            $self->dropPrivileges;
            # just exit on error, exception propagated below
            eval { $self->exe(@cmd); };
            exit $?;
        } else {
            waitpid($pid, 0);
            # propagate exception upon system() failure in fork
            die if ($? != 0);
            return;
        }
    }

    # Just like exeHighPriv for now, and confesses upon failure
    $self->exe(@cmd);
}

sub which {
    my ($self, $exe) = @_;

    foreach my $path (File::Spec->path()) {
        my $file = File::Spec->catfile($path, $exe);
        return $file if -x $file;
    }
    return;
}

sub detect_configuration
{
    my ($self) = @_;

    die "You need to configure Qt before you try to build it, aborting." if (!-e 'qtbase/.qmake.cache');

    use Cwd qw(abs_path);
    use Env qw(@PATH);

    my $abs_path = abs_path('qtbase/bin');
    unshift @PATH, $abs_path;

    my $opts = "";
    $opts = "-j" if ($self->{'jobs'} >= 0);
    $opts .= " $self->{'jobs'}" if ($self->{'jobs'} > 0);
    $self->{'MAKEOPTS'} = $opts;
    $self->{'MAKE'} = $ENV{MAKE} || "make";

    if ("$Config{osname}" =~ /mswin/i) {
        my $exe = $self->which("nmake.exe");
        $exe = $self->which("jom.exe") if (defined $exe && $self->which("jom.exe"));
        $exe = $self->which("mingw32-make.exe") if (!defined $exe);

        if (defined $exe) {
            $self->{'MAKE'} = "\"$exe\"";

            if ($exe =~ 'nmake') {
                # Use the /MP compiler option if using nmake, to use all CPU threads when compiling
                my $cl = $ENV{'CL'};
                if (defined $cl) {
                    $cl .= ' /MP';
                } else {
                    $cl = '/MP';
                }
                $ENV{'CL'} = $cl;
                # Remove the -j option, since nmake cannot handle it.
                $self->{'MAKEOPTS'} = "";
            } elsif ($exe =~ 'jom' && $self->{'jobs'} == 0) {
                # Jom currently doesn't handle the -j (unlimited) option, so remove it.
                $self->{'MAKEOPTS'} = "";
            }

            if ($exe =~ 'nmake|jom') {
                $self->{'MAKEOPTS'} = "/N $self->{'MAKEOPTS'}" if ($self->{'dry-run'} > 1);
                $self->{'MAKEOPTS'} = "/K $self->{'MAKEOPTS'}" if ($self->{'continue'} > 1);
            }
        }

        # Tools needed for building QtWebKit/Windows (Bison, Flex, gperf, iconv)
        my $abs_path = abs_path('gnuwin32/bin');
        unshift @PATH, "$abs_path";
    }
    if ($self->{'MAKE'} !~ "nmake|jom") {
        $self->{'MAKEOPTS'} = "--dry-run $self->{'MAKEOPTS'}" if ($self->{'dry-run'} > 1);
        $self->{'MAKEOPTS'} = "--keep-going $self->{'MAKEOPTS'}" if ($self->{'continue'} > 1);
    }
}

sub find_pro_file
{
    my ($self, $dir) = @_;
    my $D;
    if (opendir($D,$dir)) {
        ($dir =~ /\/$/) || ($dir .= "/");
        foreach my $file (sort readdir($D)) {
            if ($file  =~ /^.*\.pro$/) {
                closedir($D);
                return $file;
            }
        }
        closedir($D);
    }
}

sub eliminate_empty_modules
{
    my ($self) = @_;
    foreach my $repo (keys(%{$self->{'deps'}})) {
        if (!$self->find_pro_file($repo)) {
            printf "Missing module %s, ignored\n", $repo;
            delete $self->{'deps'}->{$repo};
        }
    }
}

sub check_build_module
{
    my ($self, $module) = @_;
    my @missing_link;
    foreach my $submod (split(/,/, $self->{'deps'}->{$module})) {
        next if ($submod =~ /:s$/);  # Soft dependency
        if (defined $self->{'deps'}->{$submod}) {
            push(@missing_link, $self->check_build_module($submod));
        } else {
            push(@missing_link, $submod);
        }
    }
    return @missing_link;
}

sub check_build_modules
{
    my ($self, $fail) = @_;
    my $letsdie = 0;
    foreach my $module (@{$self->{'build-submodules'}}) {
        if (defined $self->{'deps'}->{$module}) {
            my @missing_link = $self->check_build_module($module);
            if (scalar @missing_link) {
                $letsdie = 1;
                my $mods = join(", ", @missing_link);
                print STDERR "Ignoring module '$module': requires $mods\n";
            }
        } else {
            print STDERR "No module named '$module'\n";
            $letsdie = 1;
        }
    }
    die "FAIL: Missing module dependencies, build aborted." if ($letsdie && $fail);
}

sub resolve_soft_dependencies
{
    my ($self) = @_;

    my @nondefault = @{$self->{'nondefault'}};
    foreach my $module (keys(%{$self->{'deps'}})) {
        my @deps = split(/,/, $self->{'deps'}->{$module});
        my @newdeps;
        foreach my $dep (@deps) {
            if ($dep =~ /(.*):s$/) {
                my $mod = $1;
                if (defined $self->{'deps'}->{$mod}
                    && !grep {$_ eq $mod} @nondefault) {
                    push(@newdeps, $mod);
                }
            } else {
                push(@newdeps, $dep);
            }
        }
        $self->{'deps'}->{$module} = join(",", @newdeps);
    }
}

sub mark_as_finished
{
    my ($self, $doneModule) = @_;

    delete $self->{'deps'}->{$doneModule};
    foreach my $module (keys(%{$self->{'deps'}})) {
        my @deps = split(/,/, $self->{'deps'}->{$module});
        @deps = grep { $_ !~ /$doneModule/ } @deps;
        $self->{'deps'}->{$module} = join(",", @deps);
    }
}

sub get_next_modules
{
    my ($self, $module) = @_;

    my @nextModules;
    my $deps = $self->{'deps'}->{$module};
    return if (!defined $deps);
    $self->{'seenHash'}->{$module}++;
    if ($deps eq '') {
        push (@nextModules, $module);
        return @nextModules;
     }

    foreach my $dep (split(/,/, $deps)) {
        push (@nextModules, $self->get_next_modules($dep)) unless $self->{'seenHash'}->{$dep};
    }

    return @nextModules;
}

sub get_all_next_modules
{
    my ($self) = @_;

    $self->{'seenHash'} = ();

    my @nextModules;
    foreach my $module (@{$self->{'build-submodules'}}) {
        my @mods = $self->get_next_modules($module);
        push(@nextModules, @mods);
    }

    my %seen = ();
    my @uniqModules;
    foreach my $item (@nextModules) {
        push(@uniqModules, $item) unless $seen{$item}++;
    }

    return @uniqModules;
}

sub build_project
{
    my ($self, $module) = @_;
    my $build_command = $self->{'buildcmds'}->{$module};
    my $install_command = $self->{'instcmds'}->{$module};
    if (!defined $build_command) {
        if (!-e "$module/Makefile") {
            $self->exeLowPriv("cd $module && qmake -r");
        }
        $build_command = "$self->{MAKE} $self->{MAKEOPTS}";
    }
    eval { $self->exeLowPriv("cd $module && $build_command"); };
    if ($@) {
        print STDERR "'cd $module && $build_command' failed: $?\n";
        if ($self->{'continue'}) {
            print STDERR "Ignoring failure building $module (--continue)\n";
        } else {
            confess "Fatal failure building $module";
        }
    }
    $install_command = "$self->{MAKE} install" if (!defined $install_command);
    ### TODO: Should be fixed after the alpha
    unless ("$Config{osname}" =~ /(dar|ms)win/i) {
        eval { $self->exeHighPriv("cd $module && $install_command"); };
        if ($@) {
            print STDERR "'cd $module && $install_command failed: $?\n";
            if ($self->{'continue'}) {
                print STDERR "Ignoring failure installing $module (--continue)\n";
            } else {
                confess "Fatal failure installing $module";
            }
        }
    }
    $self->mark_as_finished($module);
    return 0;
}

sub build_qt
{
    my ($self) = @_;

    printf "OS Name ........ %s\n", $Config{osname};
    printf "Verbose ........ %s\n", ($self->{'verbose'} ? $self->{'verbose'} : "no");
    printf "Continue ....... %s\n", ($self->{'continue'} ? "yes" : "no");
    printf "Force qmake..... %s\n", ($self->{'force_qmake'} ? "yes" : "no");
    printf "Jobs ........... %s\n", ($self->{'jobs'} >= 0 ? $self->{'jobs'} : "unset");

    my $path = $ENV{'PATH'};
    print "PATH $path\n";

    print "Modules to build:\n";
    my $mods = "(all present)";
    $mods = join(", ", @{$self->{'build-submodules'}}) if (@{$self->{'build-submodules'}});
    print "    $mods\n";

    while (my @modules = $self->get_all_next_modules) {
        foreach my $module (@modules) {
            print "build $module...\n";
            $self->build_project($module);
        }
    }

    print "build done!\n";

    return 0;
}

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

    my $self = {};
    bless $self, $class;

    $self->parse_arguments(@arguments);
    $self->detect_configuration;

    my $depfile = "build.dependencies";
    my $result;
    our (%build_dependencies, %build_commands, %install_commands, @nondefault_modules);

    # following variables may be expanded in the evaluation below
    my $MAKEOPTS = $self->{'MAKEOPTS'};
    my $MAKE = $self->{'MAKE'};

    unless ($result = do $depfile) {
        die "build couldn't parse $depfile: $@" if $@;
        die "build couldn't execute $depfile: $!" unless defined $result;
    }

    $self->{'deps'} = \%build_dependencies;
    $self->{'buildcmds'} = \%build_commands;
    $self->{'instcmds'} = \%install_commands;
    $self->{'nondefault'} = \@nondefault_modules;

    return $self;
}

sub run
{
    my ($self) = @_;

    $self->eliminate_empty_modules;

    if (scalar @{$self->{'build-submodules'}} > 0) {
        $self->check_build_modules(1);
    } else {
        my @default = keys(%{$self->{'deps'}});
        my @nondefault = @{$self->{'nondefault'}};
        foreach my $item (@nondefault) {
            @default = grep { $_ ne $item } @default;
        }
        push(@{$self->{'build-submodules'}}, @default);
        $self->check_build_modules(0);
    }

    $self->resolve_soft_dependencies;

    $self->build_qt;

#    print Dumper($self);

    return;
}

#==============================================================================

Qt::Build->new(@ARGV)->run if (!caller);
1;