sbofind

#!/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_build_queue get_installed_packages get_reverse_reqs %config $slackbuilds_txt $repo_path show_version in indent get_from_info uniq /;
use File::Basename;
use Getopt::Long qw(:config bundling);

my $self = basename($0);

sub show_usage {
	print <<"EOF";
Usage: $self (search_term)

Options:
  -h|--help:
    this screen.
  -v|--verison:
    version information.
  -e|--exact:
    only exact matching.
  -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.
  -R|--reverse:
    show any installed reverse dependencies.
  -q|--queue:
    show the build queue for each found item.

Example:
  $self regedit

EOF
	return 1;
}

my ($help, $vers, $search_exact, $exclude_tags, $show_info, $show_reverse, $show_readme, $show_queue);

GetOptions(
	'help|h'    => \$help,
	'version|v' => \$vers,
	'exact|e'   => \$search_exact,
	'no-tags|t' => \$exclude_tags,
	'info|i'    => \$show_info,
	'readme|r'  => \$show_readme,
	'reverse|R' => \$show_reverse,
	'queue|q'   => \$show_queue,
);

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

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

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

# get installed SlackBuilds and reverse dependency information if there is a
# query, but only once
my (@installed, $installed, $fulldeps);
if ($show_reverse) {
	@installed = @{ get_installed_packages('SBO') };
	$installed = +{ map {; $_->{name}, $_->{pkg} } @installed };
	$fulldeps = get_reverse_reqs($installed);
}

# 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_exact ? qr/^(\S+).*(:\s|,)\b\Q$search_arg\E\b(,|$)/i : qr/^(\S+):\s.*\Q$search_arg\E/i;
	my $search_name_re = $search_exact ? qr/^\Q$search_arg\E$/i : qr/.*\Q$search_arg\E.*/i;

	# 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) {
		_race::cond('$tags_file may be deleted after -f check');
		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;
				}
			}
		}
	}

	my $loc_regex = qr/LOCATION:\s+\.?(.*)$/;
	my ($fh, $exit) = open_read $slackbuilds_txt;
	if ($exit) {
		warn $fh;
		exit $exit;
	}
	my (%local, @findings);
	FIRST: while (my $line = <$fh>) {
		if ($line =~ /NAME:\s+(.*)$/) {
			my $name = $1;

			# Try to match either one of the names from TAGS.txt or the search string

			my $names = @names;
			# Whenever we find an element equal to $name, throw it away (and
			# replace with last element rather than shifting stuff around)
			for (reverse @names) { $_ = pop @names if $_ eq $name; }

			# next if $name didn't match either one of @names or $search_name_re
			if ($names == @names and $name !~ $search_name_re) { next FIRST; }

			# We only reach this point if $name matched one of @names, or if
			# $search_name_re matched

			# If the name matches a local override, use its location
			if ($config{LOCAL_OVERRIDES} ne 'FALSE' and -d "$config{LOCAL_OVERRIDES}/$name") {
				push @findings, {name => $name, location => "$config{LOCAL_OVERRIDES}/$name", local => 1 };
				$local{$name} = 1;
				next FIRST;
			}

			# Otherwise the location should be in the next line
			LOCATION: {
				my $loc_line = <$fh>;
				if (my ($location) = $loc_line =~ $loc_regex) {
					push @findings, {name => $name, location => $repo_path . $location};
					next FIRST;
				} else {
					redo LOCATION; # But if it isn't, we try again...
				}
			}
		}
	}
	if ($config{LOCAL_OVERRIDES} ne 'FALSE') {
		opendir(my $dh, $config{LOCAL_OVERRIDES});
		while (my $dir = readdir($dh)) {
			next if $local{$dir};
			if ($dir =~ $search_name_re or in($dir, @names)) {
				push @findings, {name => $dir, location => "$config{LOCAL_OVERRIDES}/$dir", local => 1 };
			}
		}
		closedir $dh;
	}
	return \@findings;
}

# 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;
	my @list;
	for my $sbo (keys %$installed) {
		push @list, $sbo if $fulldeps->{$found}->{$sbo};
	}

	if (@list) {
		for my $revdep (@list) {
			my $newlist = show_reverse_dependencies($revdep);
			if ($newlist ne "None") { push @list, split(" ", $newlist); }
		}
		my @result = uniq @list;
		my @return = sort(@result);
		return join(" ", @return);
	} else {
		return "None";
	}
}

my $notfound = 0;
for my $search (@ARGV) {
	my $findings = perform_search($search);

	# pretty formatting
	if (exists $$findings[0]) {
		for my $hash (@$findings) {
			if ($notfound) { say ''; }
			my $name = $hash->{name};
			my $location = $hash->{location};
			my $version = get_from_info(LOCATION => $location, GET => 'VERSION')->[0];
			my $sbo = "SBo:   "; $sbo = "Local: " if $hash->{local};
			say "$sbo $name $version";
			say "Path:   $location";
			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 '';
			$notfound = 0;
		}
	} else {
		say "Nothing found for search term: $search";
		$notfound = 1;
	}
}

exit 0;