sboclean

#!/usr/bin/perl
#
# vim: ts=4:noet
#
# sboclean
# script to clean stuff left around from sbotools.
#
# authors: Jacob Pipkin <jacob.pipkin@icloud.com>
#          Luke Williams <xocel@iquidus.org>
#          Andreas Guldstrand <andreas.guldstrand@gmail.com>
# maintainer: K. Eugene Carlson <kvngncrlsn@gmail.com>
# license: MIT License

use 5.16.0;
use strict;
use warnings FATAL => 'all';
use SBO::Lib qw/ prompt usage_error script_error in_regexp show_version lint_sbo_config wrapsay :colors %config /;
use File::Basename;
use Getopt::Long qw(:config bundling);
use File::Path qw(remove_tree);

my $self = basename($0);

sub show_usage {
	print <<"EOF";
Usage: $self [options]
       $self -o ALL|sbo

Options:
  -h|--help:
    this screen.
  -v|--version:
    version information.
  --(no)color:
    (do not) use sbotools color output.
  --(no)wrap:
    (do not) wrap sbotools output.
  -d|--dist:
    clean distfiles.
  -w|--work:
    clean working directories.
  -o|--option (ALL|package):
    clean saved options.
  -i|--interactive:
    use prompts before deleting files.
EOF
	return 1;
}

my ($help, $vers, $dist, $work, $options, $interactive, $nocolor, $color, $nowrap, $wrap);

my $options_ok = GetOptions(
	'help|h'            => \$help,
	'version|v'         => \$vers,
	'dist|clean-dist|d' => \$dist,
	'work|clean-work|w' => \$work,
	'options|o=s'       => \$options,
	'interactive|i'     => \$interactive,
	'nocolor'           => \$nocolor,
	'color'             => \$color,
	'nowrap'            => \$nowrap,
	'wrap'              => \$wrap,
);

if ($help) {
	show_usage();
	wrapsay "\nThis is a root-only script." unless $< == 0;
	exit 0;
}
if ($vers) { show_version(); exit 0 }
$config{COLOR} = $color ? 'TRUE' : 'FALSE' if $color xor $nocolor;
$config{NOWRAP} = $nowrap ? 'TRUE' : 'FALSE' if $wrap xor $nowrap;
unless ($< == 0) {
	show_usage();
	usage_error "\nThis is a root-only script.";
}
unless ($options_ok) {
	show_usage();
	usage_error "\nOne or more invalid options detected.";
}

lint_sbo_config($self, %config);

usage_error("You must specify at least one of -d, -w or -o.") unless
	($dist || $work || $options);

sub rm_full {
	script_error('rm_full requires at least one argument.') unless @_ >= 1;
	my ($full, $dist) = @_;
	my $message;
	if ($dist) {
		my $base = basename($full);
		$message = "Remove $base from $config{SBO_HOME}/distfiles?";
	} else {
		$message = "Remove $full?";
	}
	if ($interactive) {
		return() unless prompt($color_lesser, "$message", default => 'no');
	}
	unlink $full if -f $full;
	remove_tree($full) if -d $full;
	return 1;
}

sub remove_stuff {
	script_error 'remove_stuff requires an argument.' unless @_ == 1;
	my $dir = shift;
	unless (-d $dir) {
		say 'Nothing to do.';
		return 0;
	}
	opendir(my $dh, $dir);
	FIRST: while (my $ls = readdir $dh) {
		next FIRST if in_regexp($ls => qw/ . .. /);
		rm_full("$dir/$ls");
	}
	return 1
}

sub clean_c32 {
	my $dir = $SBO::Lib::tmpd;
	opendir(my $dh, $dir);
	FIRST: while (my $ls = readdir $dh) {
		next FIRST unless $ls =~ /^package-.+-compat32$/;
		rm_full("$dir/$ls");
	}
	return 1;
}

if ($dist) {
	my $distfiles = "$config{SBO_HOME}/distfiles";
	opendir(my $dh, $distfiles);
	FIRST: while (my $ls = readdir $dh) {
		next FIRST if in_regexp($ls => qw/ . .. /);
		my $dir = "$distfiles/$ls";
		if (-d $dir) {
			opendir(my $dh2, $dir);
			SECOND: while (my $ls2 = readdir $dh2) {
				rm_full("$dir/$ls2", 1) unless in_regexp($ls2 => qw/ . .. /);
				remove_tree($dir) unless -f "$dir/$ls2";
			}
		} elsif (-f $dir) {
			rm_full($dir, 1);
		}
	}
}

if ($work) {
	my $env_tmp = $SBO::Lib::env_tmp;
	my $tsbo = $SBO::Lib::tmpd;
	if ($env_tmp && !$interactive) {
		remove_stuff($tsbo) if prompt($color_warn, "This will remove the entire contents of $env_tmp.\nProceed?", default => 'yes');
	} else {
		remove_stuff($tsbo);
	}
	clean_c32();
}

if ($options) {
	my $opt_dir = "/var/log/sbotools";
	if ($options eq 'ALL') {
		remove_stuff($opt_dir)
	} else {
		if (-f "$opt_dir/$options" && $interactive) {
			unlink("$opt_dir/$options") if prompt($color_lesser, "This will clear the saved options for $options.\nProceed?", default => 'no');
		} elsif (-f "$opt_dir/$options") {
			unlink("$opt_dir/$options");
		} else {
			wrapsay "No options are saved for $options.";
		}
	}
}

END { say ""; }