#!/usr/bin/perl
#
# vim: ts=4:noet
#
# sbofind
# script to locate something in a local SlackBuilds tree.
#
# authors: Jacob Pipkin <j@dawnrazor.net>
#          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/ slackbuilds_or_fetch slurp script_error open_read get_all_available get_build_queue get_installed_cpans get_installed_packages get_full_reverse get_reverse_reqs get_sbo_build_number get_sbo_description get_sbo_location get_sbo_version is_local on_blacklist build_cmp version_cmp :colors %config $slackbuilds_txt $repo_path @last_level_reverse @reverse_concluded $is_sbotest show_version in indent get_from_info uniq lint_sbo_config wrapsay $descriptions_generated /;
use Cwd;
use File::Basename;
use Getopt::Long qw(:config bundling);

my $self = basename($0);
my $label = $is_sbotest ? "sbotest find" : $self;

sub show_usage {
	print <<"EOF";
Usage: $label (options) search_term ...

Options:
  -h|--help:
    this screen.
  -v|--verison:
    version information.
  --(no)color:
    (do not) use sbotools color output.
  --(no)wrap:
    (do not) wrap sbotools output.
  -A|--all-reverse:
    show all reverse dependencies in the repo.
  -E|--exact-case:
    only exact matching (case-sensitive).
  -d|--descriptions:
    return matches in descriptions.
  -e|--exact:
    only exact matching (case-insensitive).
  -F|--first-reverse:
    show the first level of reverse dependencies.
  -t|--no-tags:
    exclude tags from search.
  -i|--info:
    show the .info for each found item.
  -r|--readme:
    show the README for each found item.
  -q|--queue:
    show the build queue for each found item.
  -R|--reverse:
    show any installed reverse dependencies.
  -T|--top-reverse
    show the last level of reverse dependencies.
  --raw
    print matching package names only, alphabetized.

Examples:
  $label regedit
  $label -qe libsystemd snapd
EOF
	return 1;
}

my ($help, $vers, $search_exact, $search_case, $exclude_tags, $show_info, $show_reverse, $show_readme, $show_queue, $all_reverse, $last_reverse, $first_reverse, $nocolor, $color, $raw, $nowrap, $wrap, $search_descriptions);

GetOptions(
	'help|h'    => \$help,
	'version|v' => \$vers,
	'd|descriptions' => \$search_descriptions,
	'exact|e'   => \$search_exact,
	'exact-case|E' => \$search_case,
	'no-tags|t' => \$exclude_tags,
	'info|i'    => \$show_info,
	'readme|r'  => \$show_readme,
	'reverse|R' => \$show_reverse,
	'queue|q'   => \$show_queue,
	'all-reverse|A' => \$all_reverse,
	'top-reverse|T' => \$last_reverse,
	'first-reverse|F' => \$first_reverse,
	'nocolor' => \$nocolor,
	'color' => \$color,
	'raw' => \$raw,
	'nowrap' => \$nowrap,
	'wrap' => \$wrap,
);

if ($help) { show_usage(); exit 0 }
if ($vers) { show_version(); exit 0 }

$config{COLOR} = $color ? 'TRUE' : 'FALSE' if $color xor $nocolor;
$config{NOWRAP} = $nowrap ? 'TRUE' : 'FALSE' if $color xor $nocolor;
lint_sbo_config($self, %config);

if (!@ARGV) { show_usage(); exit 1 }

# if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree
slackbuilds_or_fetch();
my @available = get_all_available();

# used to report package installation status
my (@installed, $installed_times, $installed_vers, @installed_std, $std_times, $std_vers);
# these will be used later in case of reverse dependency searches
my ($available, $all_fulldeps, $installed, $fulldeps);
# this is relevant only in --raw mode
my @raw_printout;

# get lists of installed and defective CPAN modules
my (@cpans, @defective_cpans);
my ($pms, $defective) = get_installed_cpans();
s/::/-/g for @$pms;
s/::/-/g for @$defective;

# find anything with $search in its name
sub perform_search {
	script_error 'perform_search requires an argument.' unless @_ == 1;
	my $search_arg = shift;
	my ($search_tag_re, $search_desc_re, $search_name_re);
	unless ($search_case) {
		$search_tag_re  = $search_exact ? qr/^(\S+).*(:\s|,)\b\Q$search_arg\E\b(,|$)/i : qr/^(\S+):\s.*\Q$search_arg\E/i;
		$search_desc_re = $search_exact ? qr/(\W|^)\Q$search_arg\E(\W|$)/i : qr/.*\Q$search_arg\E.*/i;
		$search_name_re = $search_exact ? qr/^\Q$search_arg\E$/i : qr/.*\Q$search_arg\E.*/i;
	} else {
		$search_tag_re  = qr/^(\S+).*(:\s|,)\b\Q$search_arg\E\b(,|$)/;
		$search_desc_re = qr/(^|\W)\Q$search_arg\E(\W|$)/;
		$search_name_re = qr/^\Q$search_arg\E$/;
	}

	# first get a bunch of names from the TAGS.txt if it's available
	my $tags_file = "$config{SBO_HOME}/repo/TAGS.txt";
	my @names;
	if (!$exclude_tags && -f $tags_file) {
		my ($t_fh, $t_exit) = open_read "$config{SBO_HOME}/repo/TAGS.txt";
		unless ($t_exit) {
			while (my $line = <$t_fh>) {
				if ($line =~ $search_tag_re) {
					push @names, $1;
				}
			}
		}
	}

	if ($search_descriptions) {
		for (@available) {
			push @names, $_ if get_sbo_description($_) =~ $search_desc_re;
		}
	}

	my @findings;
	for (@available) {
		push @findings, {name => $_, location => get_sbo_location($_), local => is_local($_)} if
			$_ =~ $search_name_re or in $_, @names;
	}
	return \@findings;
}

# sbotest only; determine whether an up-to-date version of the script has
# been archived
sub in_archive {
	script_error("in_archive requires an argument. Exiting.") unless @_ == 1;
	my $search_name = shift;
	return 0 unless $is_sbotest and -d $config{SBO_ARCHIVE};
	my $archived = 0;
	my $cwd = getcwd();
	chdir $config{SBO_ARCHIVE};
	opendir(my $dh, $config{SBO_ARCHIVE});
	while (my $ls = readdir $dh) {
		next unless -f $ls and $ls =~ m/^$search_name/;
		# indicates a potentially valid _SBo package name
		next unless $ls =~ m/_SBo(|compat32)\.(t[gxlb]z|tar\.([gxl]z|bz2|lzma))$/;
		my $pkg_name = $ls;
		my @pkg_string = split '-', $pkg_name;
		my $pkg_version = $pkg_string[-3];
		my $pkg_build = $pkg_string[-1];
		$pkg_build =~ s/[\D].*$//;
		$pkg_name =~ s/(-[^-]*){3}$//;
		next unless defined $pkg_name and defined $pkg_build and defined $pkg_name;
		next unless $pkg_name eq $search_name;
		my $pkg_location = get_sbo_location($pkg_name);
		next unless $pkg_location;
		my $sbo_version = get_sbo_version($pkg_location);
		my $sbo_build = get_sbo_build_number($pkg_location);
		next if version_cmp($pkg_version, $sbo_version);
		next if build_cmp($pkg_build, $sbo_build, $pkg_version, $sbo_version);
		# the package is up-to-date if this point has been reached
		$archived = 1;
		last;
	}
	close $dh;
	chdir $cwd;
	return $archived;
}


# get reverse dependency information if there is a query, but only once
sub reverse_queries {
	if ($all_reverse or $last_reverse or $first_reverse) {
		$available = +{ map {; $_, $_ } @available };
		$all_fulldeps = get_reverse_reqs($available);
	}
	if ($show_reverse) {
		$installed = +{ map {; $_->{name}, $_->{pkg} } @installed };
		$fulldeps = get_reverse_reqs($installed);
	}
}

# clear the shared completion arrays before performing dependency and
# reverse dependency calculations
sub splice_arrays {
	splice @reverse_concluded;
	splice @last_level_reverse;
}

# pull the contents of a file into a variable and format it for output
sub get_file_contents {
	script_error 'get_file_contents requires an argument.' unless @_ == 1;
	my $file = shift;
	my $contents = slurp($file);
	return "Unable to open $file.\n" unless defined $contents;
	return "\n" . indent 6, $contents;
}

# get build queue and return it as a single line.
sub show_build_queue {
	script_error('show_build_queue requires an argument.') unless @_ == 1;
	my $queue = get_build_queue([shift]);
	return join(" ", @$queue);
}

# get installed reverse dependencies and return them as a single line.
sub show_reverse_dependencies {
	script_error('show_reverse_dependencies requires an argument.') unless @_ == 1;
	my $found = shift;
	splice_arrays();
	my @full_reverse = get_full_reverse($found, $installed, $fulldeps);
	return join(" ", sort(@full_reverse)) if @full_reverse;
	return "None";
}

# get all reverse dependencies and return them as a single line.
sub show_available_reverse {
	script_error('show_available_reverse requires an argument.') unless @_ == 1;
	my $found = shift;
	splice_arrays();
	my @available_reverse = get_full_reverse($found, $available, $all_fulldeps);
	return join(" ", @available_reverse) if @available_reverse;
	return "None";
}

# show the last level of reverse dependencies
sub last_level_reverse {
	script_error('last_level_reverse requires an argument.') unless @_ == 1;
	my $found = shift;
	splice_arrays();
	my @available_reverse = get_full_reverse($found, $available, $all_fulldeps);
	return join(" ", uniq(sort(@last_level_reverse))) if @last_level_reverse;
	return "None";
}

# show the first level of reverse dependencies
sub first_level_reverse {
	script_error('first_level_reverse requires an argument.') unless @_ == 1;
	my $found = shift;
	my @first_reverse;
	for my $sbo (keys %$available) {
		push @first_reverse, $sbo if $all_fulldeps->{$found}->{$sbo};
	}
	return join(" ", uniq(sort(@first_reverse))) if @first_reverse;
	return "None";
}

my $notfound = 0;
SEARCH: for my $search (@ARGV) {
	unless ($std_vers) {
		@installed = @{ get_installed_packages('SBO') };
		$installed_times = +{ map {; $_->{name}, $_->{created} } @installed };
		$installed_vers = +{ map {; $_->{name}, $_->{version} } @installed };
		@installed_std = @{ get_installed_packages('STD') };
		$std_times = +{ map {; $_->{name}, $_->{created} } @installed_std };
		$std_vers = +{ map {; $_->{name}, $_->{version} } @installed_std };
	}

	my $findings = perform_search($search);

	if ($raw) {
		next SEARCH unless exists $$findings[0];
		push @raw_printout, $_->{name} for @$findings;
		next SEARCH;
	}

	# pretty formatting
	if (exists $$findings[0]) {
		reverse_queries() unless $all_fulldeps or $fulldeps;
		for my $hash (@$findings) {
			if ($notfound) { say ''; }
			my $name = $hash->{name};
			if ($name =~ /^perl-/) {
				my $pm_name = $name;
				$pm_name =~ s/^perl-//;
				for my $pm (@$pms) {
					push @cpans, $name if $pm =~ /^$pm_name$/i;
				}
				for my $pm (@$defective) {
					push @defective_cpans, $name if $pm =~ /^$pm_name$/i;
				}
			}

			my $location = $hash->{location};
			my $version = get_from_info(LOCATION => $location, GET => 'VERSION')->[0];
			my $sbo = $hash->{local} ? "Local: " : "SBo:   ";
			my $description = get_sbo_description($name);
			say "$sbo $name $version";
			wrapsay_color $color_warn, "        blacklisted" if on_blacklist($name);
			wrapsay_color $color_notice, "        $installed_vers->{$name} installed ($installed_times->{$name})" if $installed_times->{$name};
			wrapsay_color $color_lesser, "        $std_vers->{$name} installed, non-SBo ($std_times->{$name})" if $std_times->{$name};
			# sbotest-only
			wrapsay_color $color_notice, "        archived" if in_archive($name);
			wrapsay_color $color_lesser, "        CPAN" if in $name, @cpans;
			wrapsay_color $color_lesser, "        CPAN, file(s) missing" if in $name, @defective_cpans;
			say "Path:   $location";
			say "Desc:   $description" if defined $description;
			say "info:   ". get_file_contents("$location/$name.info") if $show_info;
			say "README: ". get_file_contents("$location/README") if $show_readme;
			say "Queue:  ". show_build_queue($name) if $show_queue;
			say "RevDep: ". show_reverse_dependencies($name) if $show_reverse;
			say "AllRev: ". show_available_reverse($name) if $all_reverse;
			say "LstRev: ". last_level_reverse($name) if $last_reverse;
			say "1stRev: ". first_level_reverse($name) if $first_reverse;
			say '';
			$notfound = 0;
		}
		wrapsay_color $color_lesser, "Warning: Local overrides directory $config{LOCAL_OVERRIDES} does not exist.", 1 if $config{LOCAL_OVERRIDES} ne "FALSE" and not -d $config{LOCAL_OVERRIDES};
		wrapsay_color $color_lesser, "Run sbocheck to generate descriptions.", 1 unless $descriptions_generated;
	} else {
		wrapsay_color $color_lesser, "Nothing found for search term: $search";
		$notfound = 1;
	}
}

if (@raw_printout) {
	@raw_printout = sort(uniq(@raw_printout));
	print join(" ", @raw_printout);
}

END { say "" if not $raw and ($notfound or $?); }
