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;