sbotools2

Maintenance fork of the original sbotools version 2
git clone git://git.server.ky/slackcoder/sbotools2
Log | Files | Refs | README

sbofind (5298B)


      1 #!/usr/bin/perl
      2 #
      3 # vim: ts=4:noet
      4 #
      5 # sbofind
      6 # script to locate something in a local SlackBuilds tree.
      7 #
      8 use 5.16.0;
      9 use strict;
     10 use warnings FATAL => 'all';
     11 use SBO::Lib qw/ slackbuilds_or_fetch slurp script_error open_read get_build_queue %config $slackbuilds_txt $repo_path show_version in indent get_from_info /;
     12 use File::Basename;
     13 use Getopt::Long qw(:config bundling);
     14 
     15 my $self = basename($0);
     16 
     17 sub show_usage {
     18 	print <<"EOF";
     19 Usage: $self (search_term)
     20 
     21 Options:
     22   -h|--help:
     23     this screen.
     24   -v|--verison:
     25     version information.
     26   -e|--exact:
     27     only exact matching.
     28   -t|--no-tags:
     29     exclude tags from search.
     30   -i|--info:
     31     show the .info for each found item.
     32   -r|--readme:
     33     show the README for each found item.
     34   -q|--queue:
     35     show the build queue for each found item.
     36 
     37 Example:
     38   $self libsexy
     39 
     40 EOF
     41 	return 1;
     42 }
     43 
     44 my ($help, $vers, $search_exact, $exclude_tags, $show_info, $show_readme, $show_queue);
     45 
     46 if (! GetOptions(
     47 	'help|h'    => \$help,
     48 	'version|v' => \$vers,
     49 	'exact|e'   => \$search_exact,
     50 	'no-tags|t' => \$exclude_tags,
     51 	'info|i'    => \$show_info,
     52 	'readme|r'  => \$show_readme,
     53 	'queue|q'   => \$show_queue,
     54 )) {
     55   show_usage();
     56   exit 1;
     57 }
     58 
     59 if ($help) { show_usage(); exit 0 }
     60 if ($vers) { show_version(); exit 0 }
     61 
     62 if (!@ARGV) { show_usage(); exit 1 }
     63 my $search = $ARGV[0];
     64 
     65 # if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree
     66 slackbuilds_or_fetch();
     67 
     68 # find anything with $search in its name
     69 sub perform_search {
     70 	script_error 'perform_search requires an argument.' unless @_ == 1;
     71 	my $search_arg = shift;
     72 	my $search_tag_re  = $search_exact ? qr/^(\S+).*(:\s|,)\b\Q$search_arg\E\b(,|$)/i : qr/^(\S+):\s.*\Q$search_arg\E/i;
     73 	my $search_name_re = $search_exact ? qr/^\Q$search_arg\E$/i : qr/.*\Q$search_arg\E.*/i;
     74 
     75 	# first get a bunch of names from the TAGS.txt if it's available
     76 	my $tags_file = "$config{SBO_HOME}/repo/TAGS.txt";
     77 	my @names;
     78 	if (!$exclude_tags && -f $tags_file) {
     79 		_race::cond('$tags_file may be deleted after -f check');
     80 		my ($t_fh, $t_exit) = open_read "$config{SBO_HOME}/repo/TAGS.txt";
     81 		unless ($t_exit) {
     82 			while (my $line = <$t_fh>) {
     83 				if ($line =~ $search_tag_re) {
     84 					push @names, $1;
     85 				}
     86 			}
     87 		}
     88 	}
     89 
     90 	my $loc_regex = qr/LOCATION:\s+\.?(.*)$/;
     91 	my ($fh, $exit) = open_read $slackbuilds_txt;
     92 	if ($exit) {
     93 		warn $fh;
     94 		exit $exit;
     95 	}
     96 	my (%local, @findings);
     97 	FIRST: while (my $line = <$fh>) {
     98 		if ($line =~ /NAME:\s+(.*)$/) {
     99 			my $name = $1;
    100 
    101 			# Try to match either one of the names from TAGS.txt or the search string
    102 
    103 			my $names = @names;
    104 			# Whenever we find an element equal to $name, throw it away (and
    105 			# replace with last element rather than shifting stuff around)
    106 			for (reverse @names) { $_ = pop @names if $_ eq $name; }
    107 
    108 			# next if $name didn't match either one of @names or $search_name_re
    109 			if ($names == @names and $name !~ $search_name_re) { next FIRST; }
    110 
    111 			# We only reach this point if $name matched one of @names, or if
    112 			# $search_name_re matched
    113 
    114 			# If the name matches a local override, use its location
    115 			if ($config{LOCAL_OVERRIDES} ne 'FALSE' and -d "$config{LOCAL_OVERRIDES}/$name") {
    116 				push @findings, {name => $name, location => "$config{LOCAL_OVERRIDES}/$name", local => 1 };
    117 				$local{$name} = 1;
    118 				next FIRST;
    119 			}
    120 
    121 			# Otherwise the location should be in the next line
    122 			LOCATION: {
    123 				my $loc_line = <$fh>;
    124 				if (my ($location) = $loc_line =~ $loc_regex) {
    125 					push @findings, {name => $name, location => $repo_path . $location};
    126 					next FIRST;
    127 				} else {
    128 					redo LOCATION; # But if it isn't, we try again...
    129 				}
    130 			}
    131 		}
    132 	}
    133 	if ($config{LOCAL_OVERRIDES} ne 'FALSE') {
    134 	    my $dh;
    135 		if (! opendir($dh, $config{LOCAL_OVERRIDES})) {
    136 		  print(STDERR "could not read the configured LOCAL_OVERRIDES directory '$config{LOCAL_OVERRIDES}'.\n");
    137 		  exit(1);
    138 		}
    139 
    140 		while (my $dir = readdir($dh)) {
    141 			next if $local{$dir};
    142 			if ($dir =~ $search_name_re or in($dir, @names)) {
    143 				push @findings, {name => $dir, location => "$config{LOCAL_OVERRIDES}/$dir", local => 1 };
    144 			}
    145 		}
    146 		closedir $dh;
    147 	}
    148 	return \@findings;
    149 }
    150 
    151 # pull the contents of a file into a variable and format it for output
    152 sub get_file_contents {
    153 	script_error 'get_file_contents requires an argument.' unless @_ == 1;
    154 	my $file = shift;
    155 	my $contents = slurp($file);
    156 	return "Unable to open $file.\n" unless defined $contents;
    157 	return "\n" . indent 6, $contents;
    158 }
    159 
    160 # get build queue and return it as a single line.
    161 sub show_build_queue {
    162 	script_error('show_build_queue requires an argument.') unless @_ == 1;
    163 	my $queue = get_build_queue([shift], {});
    164 	return join(" ", @$queue);
    165 }
    166 
    167 my $findings = perform_search($search);
    168 
    169 # pretty formatting
    170 if (exists $$findings[0]) {
    171 	for my $hash (@$findings) {
    172 		my $name = $hash->{name};
    173 		my $location = $hash->{location};
    174 		my $version = get_from_info(LOCATION => $location, GET => 'VERSION')->[0];
    175 		my $sbo = "SBo:   "; $sbo = "Local: " if $hash->{local};
    176 		say "$sbo $name $version";
    177 		say "Path:   $location";
    178 		say "info:   ". get_file_contents("$location/$name.info") if $show_info;
    179 		say "README: ". get_file_contents("$location/README") if $show_readme;
    180 		say "Queue:  ". show_build_queue($name) if $show_queue;
    181 		say '';
    182 	}
    183 } else {
    184 	say "Nothing found for search term: $search";
    185 }
    186 
    187 exit 0;