#!/usr/bin/env perl
#
# vim: set ts=4:noet
#
# sboinstall
# script to install a SlackBuild by name
#
# author: Jacob Pipkin <j@dawnrazor.net>
# license: WTFPL <http://sam.zoy.org/wtfpl/COPYING>

use 5.16.0;
use strict;
use warnings FATAL => 'all';
use SBO::Lib;
use Getopt::Long qw(:config bundling);
use File::Basename;

my $self = basename ($0);

sub show_usage () {
    print <<EOF
Usage: $self (options) [package]

Options (defaults shown first where applicable):
  -h|--help:
    this screen.
  -v|--version:
    version information.
  -c|--noclean (FALSE|TRUE):
    set whether or not to clean working directories after building.
  -d|--distclean (TRUE|FALSE):
    set whether or not to clean distfiles afterward.
  -f|--force:
    force an update, even if the "upgrade" version is the same or lower.
  -i|--noinstall:
    do not run installpkg at the end of the build process.
  -j|--jobs (FALSE|#):
    specify "-j" setting to make, for multicore systems; overrides conf file.
  -N|--installnew:
    install any new SBo's listed.
  -r|--nointeractive:
    non-interactive; skips README and all prompts.
  -R|--norequirements:
    view the README but do not handle requirements, commands, or options.
  -z|--force-reqs:
    when used with -f, will force rebuilding an SBo's requirements as well.

EOF
}

my $noclean = $config{NOCLEAN};
my $distclean = $config{DISTCLEAN};
my $jobs = $config{JOBS};
my ($help, $vers, $force, $no_install, $install_new, $non_int, $no_reqs,
    $force_reqs, $only_new, $compat32);

GetOptions (
    'help|h'            => \$help,
    'version|v'         => \$vers,
    'noclean|c=s'       => \$noclean,
    'distclean|d=s'     => \$distclean,
    'force|f'           => \$force,
    'noinstall|i'       => \$no_install,
    'jobs|j=s'          => \$jobs,
    'installnew|N'      => \$install_new,
    'nointeractive|r'   => \$non_int,
    'norequirements|R'  => \$no_reqs,
    'force-reqs|z'      => \$force_reqs,
    'only-new|o'        => \$only_new,
    'compat32|p'        => \$compat32,
);

show_usage and exit 0 if $help;
show_version and exit 0 if $vers;
show_usage and exit 0 unless exists $ARGV[0];

$noclean = $noclean eq 'TRUE' ? 1 : 0;
$distclean = $distclean eq 'TRUE' ? 1 : 0;


my $rootpkg = $ARGV[0];
my %warnings;
my %options;
my $build_queue; 

if ($no_reqs) {
    @$build_queue = ();
    push(@$build_queue, $rootpkg); 
} else {
    $build_queue = get_build_queue($rootpkg, \%warnings);
}

my %locations = get_sbo_location ($build_queue);

sub get_readme_path ($) {
    exists $_[0] or script_error 'get_readme_path requires an argument.';
    my $sbo = shift;
    return $locations{$sbo} .'/README';
}

# look for any (user|group)add commands in the README
sub get_user_group ($) {
    exists $_[0] or script_error 'get_user_group requires an argument';
    my $readme = shift;
    my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg;
    return \@cmds;
}

# offer to run any user/group add commands
sub ask_user_group ($$) {
    exists $_[1] or script_error 'ask_user_group requires two arguments';
    my ($cmds, $readme) = @_;
    say "\n". $readme;
    print "\nIt looks like this slackbuild requires the following";
    say ' command(s) to be run first:';
    say "    # $_" for @$cmds;
    print 'Shall I run them prior to building? [y] ';
    if (<STDIN> =~ /^[Yy\n]/) {
        return $cmds;
        for my $cmd (@$cmds) {
            system ($cmd) == 0 or warn "\"$cmd\" exited non-zero\n";
        }
    }
}

# see if the README mentions any options
sub get_opts ($) {
    exists $_[0] or script_error 'get_opts requires an argument';
    my $readme = shift;
    return $readme =~ /[A-Z0-9]+=[^\s]/ ? 1 : undef;
}

# provide an opportunity to set options
sub ask_opts ($) {
    exists $_[0] or script_error 'ask_opts requires an argument';
    my $readme = shift;
    say "\n". $readme;
    print "\nIt looks this slackbuild has options; would you like to set any";
    print ' when the slackbuild is run? [n] ';
    if (<STDIN> =~ /^[Yy]/) {
        my $ask = sub () {
            print "\nPlease supply any options here, or enter to skip: ";
            chomp (my $opts = <STDIN>);
            return if $opts =~ /^\n/;
            return $opts;
        };
        my $kv_regex = qr/[A-Z0-9]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/;
        my $opts = &$ask;
        return unless $opts;
        FIRST: while ($opts !~ $kv_regex) {
            warn "Invalid input received.\n";
            $opts = &$ask; 
        }
        return $opts;
    }
    return;
}

sub user_prompt ($$) {
        exists $_[1] or script_error 'user_prompt requires two arguments.';
        my ($sbo, $location) = @_;
        my $fh = open_read ($location .'/README');
        my $readme = do {local $/; <$fh>};
        close $fh;

        # check for user/group add commands, offer to run any found
        my $user_group = get_user_group $readme;
        ask_user_group $user_group, $readme  if $$user_group[0];

        # check for options mentioned in the README
        my $opts = 0;
        $opts = ask_opts $readme if get_opts $readme;
        print "\n". $readme unless $opts;
        $options{$sbo} = $opts if $opts;
        
        print "\nProceed with $sbo? [y]: ";
        return 0 unless <STDIN> =~ /^[Yy\n]/;
        return 1;
}

# do the things with the provided sbos - whether upgrades or new installs.
sub process_sbos ($) {
    exists $_[0] or script_error 'process_sbos requires an argument.';
    my $todo = shift;
    my %failures;
    FIRST: for my $sbo (@$todo) {
        my $opts = 0;
        $opts = $options{$sbo} if defined $options{$sbo};
        # switch compat32 on if upgrading a -compat32
        # else make sure compat32 is off
        if ($sbo =~ /-compat32$/) {
            $compat32 = 1;
        } else {
            $compat32 = 0;
        }
        my ($version, $pkg, $src);
        eval { ($version, $pkg, $src) = do_slackbuild (
            OPTS    => $opts,
            JOBS    => $jobs,
            LOCATION  => $locations{$sbo},
            COMPAT32  => $compat32,
        ); };
        if ($@) {
            $failures{$sbo} = $@;
        } else {
            
            do_upgradepkg $pkg unless $no_install;      

            unless ($distclean) {
                make_clean (SBO => $sbo, SRC => $src, VERSION => $version)
                    unless $noclean;
            } else {
                make_distclean (
                    SBO     => $sbo,
                    SRC     => $src,
                    VERSION   => $version,
                    LOCATION  => $locations{$sbo},
                );
            }
            # move package to $config{PKG_DIR} if defined
            unless ($config{PKG_DIR} eq 'FALSE') {
                my $dir = $config{PKG_DIR};
                unless (-d $dir) {
                    mkdir ($dir) or warn "Unable to create $dir\n";
                }
                if (-d $dir) {
                    move ($pkg, $dir), say "$pkg stored in $dir";
                } else {
                    warn "$pkg left in /tmp\n";
                }
            } elsif ($distclean) {
                unlink $pkg;
            }
        }
    }
    return %failures;
}

sub print_failures (;%) {
    if (exists $_[0]) {
        my %failures = @_;
        say 'Failures:';
        while (my ($key, $val) = each %failures) {
            say "  $key: $val";
        }
        exit 1;
    }
}

#if (@$build_queue gt 1) {
#    my $reqline = join(' ', @$build_queue);
#    $reqline =~ s/$rootpkg//;
#    say "Requires: " . $reqline;
#}

my $installed = get_installed_sbos;
my $inst_names = get_inst_names $installed;

# deal with any updates prior to any new installs.
# no reason to bother if only_new is specified, ie running from sboinstall.
goto INSTALL_NEW if $only_new;

# doesn't matter what's updatable and what's not if force is specified
my @updates unless $force;
unless ($force) {
    my $updates = get_available_updates;
    push @updates, $$_{name} for @$updates;
}
my $upgrade_queue;
# but without force, we only want to update what there are updates for
my @remove;
unless ($force) {
    for my $sbo (@$build_queue) {
        if ($sbo ~~ @updates) {
            push @$upgrade_queue, $sbo;
            push @remove, $sbo;
        }
    }
} else {
    for my $sbo (@$build_queue) {
        if ($sbo ~~ @$inst_names) {
            push @$upgrade_queue, $sbo;
            push @remove, $sbo;
        }
    }
}

# Get user input regarding upgrades
my @temp_queue;
for my $sbo (@$upgrade_queue) {
    unless ($non_int) {
        if (user_prompt($sbo, $locations{$sbo})) {
                push(@temp_queue, $sbo);
                say "$sbo added to upgrade queue.";  
        } else {
            last;
        }
    } else {
        push(@temp_queue, $sbo);
        say "\n$sbo added to upgrade queue.";
    }
}

# Remove upgrades from build queue

for my $sbo (@$upgrade_queue) {
    if ($sbo ~~ @$build_queue) {
        my $count = 0;
        for my $i (@$build_queue) {
            if ($i eq $sbo) {
                splice(@$build_queue, $count, 1);
                last;
            }
            $count++;
        }
    }
}

@$upgrade_queue = @temp_queue;

INSTALL_NEW:
goto BEGIN_BUILD unless $install_new;
@temp_queue = ();
for my $sbo (@$build_queue) {
    my $name = $compat32 ? "$sbo-compat32" : $sbo;
    warn "$name already installed.\n" and next if $name ~~ @$inst_names;
    $locations{$name} = get_sbo_location ($sbo) if $compat32;
    unless ($non_int) {
        # if compat32 is TRUE, we need to see if the non-compat version exists.
        if ($compat32) {
            unless ($sbo ~~ @$inst_names) {
                if (user_prompt($sbo, $locations{$sbo})){
                    push(@temp_queue, $sbo);
                    say "$sbo added to install queue.";
                } else {
                    last;
                }
            } 
        }
        if (user_prompt($name, $locations{$name})) {
                push(@temp_queue, $name);
                say "$name added to install queue.";  
        } else {
            last;
        }
    } else {
        push(@temp_queue, $sbo);
        say "\n$name added to build queue.";
    }
}
@$build_queue = @temp_queue;

BEGIN_BUILD:
@$build_queue = () unless $install_new; 
exit 0 unless @$build_queue gt 0 or @$upgrade_queue gt 0;
print "\n";
say "Upgrade queue: " . join(' ', @$upgrade_queue) if exists $$upgrade_queue[0];
say "Install queue: " . join(' ', @$build_queue) if exists $$build_queue[0];
unless ($non_int) {
    print "\nAre you sure you wish to continue? [y]: ";
    exit 0 unless <STDIN> =~ /^[Yy\n]/;
}

my %failures = process_sbos $upgrade_queue if exists $$upgrade_queue[0];
print_failures %failures;

%failures = process_sbos $build_queue if exists $$build_queue[0];
print_failures %failures;

exit 0;