#!/usr/bin/env perl
#
# vim: set ts=4:noet
#
# sboremove
# script to remove an installed SlackBuild
#
# authors: Luke Williams <xocel@iquidus.org>
# 		   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] sbo

Options (defaults shown first where applicable):
  -h|--help:
    this screen.
  -v|--version:
    version information.
  -a|--alwaysask:
    always ask to remove, even if required by other packages on system.

Note: optional dependencies need to be removed separately. 

EOF
}

my ($help, $vers, $non_int, $alwaysask, @excluded);

GetOptions(
	'help|h'			=> \$help,
	'version|v'			=> \$vers,
	'nointeractive'		=> \$non_int,
	'alwaysask|a'		=> \$alwaysask,
);

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

my $inst_names = get_inst_names(get_installed_sbos);

# ensure that all provided arguments are valid sbos
my @arguments;
for my $sbo (@ARGV) {
	if (get_sbo_location($sbo)) {
		$sbo ~~ @$inst_names ? push @arguments, $sbo
                             : say "$sbo is not installed";
	} else {
		say "Unable to locate $sbo in the SlackBuilds.org tree."
	}
}

# one array of each cli-specified sbo to remove...
my @sbos = @arguments;
exit 0 unless exists $sbos[0];

# wrapper to pull the list of requirements for a given sbo
# TODO: look at moving this into Lib.pm
sub get_requires($) {
	my $location = get_sbo_location(shift);
	return get_from_info(LOCATION => $location, GET => 'REQUIRES');
}

my ($remove_queue, %required_by, %warnings, @confirmed);
# Create full queue. 
for my $sbo (@sbos) {
    my $queue = get_build_queue ([$sbo], \%warnings);
    @$queue = reverse(@$queue);
    $remove_queue = merge_queues($remove_queue, $queue);
}

# Read requires for each item in queue (needed for later on, %README% etc)
# TODO: look at returning this info back from the queue subs as they process
# this info to make the queues, however they do not store it anywhere, resulting 
# in the current double handling of the .info files :/ 
my %req_store;
$req_store{$_} = get_requires $_ for @$remove_queue;
#print "Q: " . join(' ', @$remove_queue) . "\n";

# Determine required by for all installed sbo's
sub get_reverse_reqs() {
	FIRST: for my $inst (@$inst_names) {
		my $require = get_requires $inst;
		next FIRST unless $$require[0];
		for my $req (@$require) {
			unless ( $req eq '%README%' ) {
				push @{$required_by{$req}}, $inst if $req ~~ $inst_names;
			}		
		}	
	}
}
get_reverse_reqs;

sub get_required_by($) {
	my $sbo = shift;
	my @dep_of;
	if ( $required_by{$sbo} ) {
		for my $req_by (@{$required_by{$sbo}}) {
			unless ($req_by ~~ @confirmed) {
				push @dep_of, $req_by;
			}
		}
	}
	return \@dep_of;
}

sub confirm_remove($) {
	my $sbo = shift;
	push @confirmed, $sbo unless $sbo ~~ @confirmed;
}

# Check if packages in queue are actually installed on system 
my @temp;
if ($inst_names) {
	for my $sbo (@$remove_queue) {
		push @temp, $sbo if $sbo ~~ @$inst_names;
	}
	$remove_queue = \@temp;
}

# Confirm all and skip prompts if noninteractive
if ($non_int) {
	confirm_remove $_ for @$remove_queue;
	goto CONFIRMED;
}
# Prompt user
FIRST: for my $remove (@$remove_queue) {
	my $required_by = get_required_by $remove;
	my $needed = 0; # True if sbo is still needed on system, otherwise false.
	for my $rq (@$required_by) {
		$needed = 1 unless $rq ~~ @confirmed or $remove ~~ @sbos;
	}
	
	if ( $needed ) {
		next FIRST unless $alwaysask;
		print "$remove : required by " . join(' ', @$required_by) . "\n";
	} else {
		say "$remove";
	}

	my @reqz = $req_store{$remove};
	if ( "%README%" ~~ @reqz ) {
		print "It is recommended that you view the README before continuing..\n";
		print "Display README now? [y]: ";
		my $location = get_sbo_location($remove);
		my $fh = open_read ($location .'/README');
		my $readme = do {local $/; <$fh>};
		close $fh;

		print "\n" . $readme if <STDIN> =~ /^[Yy\n]/;
	}
	print "Remove $remove? [y]: ";
	 
	if ( <STDIN> =~ /^[Yy\n]/ ) {
		confirm_remove($remove);
		say " * Added to remove queue\n";
	} else {
		say " * Ignoring\n";
	}
}	

CONFIRMED:

# Show remove queue
my $remove_count = @confirmed;
if ($remove_count) {
	say "Removing $remove_count package(s)";
	print join(' ', @confirmed) . "\n\n";
} else {
	say 'Nothing to remove.';
	exit 0;
}

unless ($non_int) {
	print 'Are you sure you want to continue? [n] : ';
	unless (<STDIN> =~ /^[Yy]/) {
		say 'Exiting.';
		exit 0;
	}
}

system("/sbin/removepkg $_") for @confirmed;

say "All operations have completed successfully.";

exit 0;