1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/openpkg/search.pl Tue Jul 31 12:23:42 2012 +0200
1.3 @@ -0,0 +1,246 @@
1.4 +##
1.5 +## search.pl -- OpenPKG Package Searching
1.6 +## Copyright (c) 2011-2012 OpenPKG GmbH <http://openpkg.com/>
1.7 +##
1.8 +## This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
1.9 +## All rights reserved. Licenses which grant limited permission to use,
1.10 +## copy, modify and distribute this software are available from the
1.11 +## OpenPKG GmbH.
1.12 +##
1.13 +## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
1.14 +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
1.15 +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
1.16 +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
1.17 +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1.18 +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1.19 +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
1.20 +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
1.21 +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1.22 +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
1.23 +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
1.24 +## SUCH DAMAGE.
1.25 +##
1.26 +
1.27 +require 5.003;
1.28 +
1.29 +# OpenPKG instance prefix and RPM
1.30 +my $my_prefix = $ENV{'OPENPKG_PREFIX'};
1.31 +my $my_rpm = "$my_prefix/bin/openpkg rpm";
1.32 +delete $ENV{'OPENPKG_PREFIX'};
1.33 +
1.34 +# program identification
1.35 +my $progname = "search";
1.36 +my $progvers = "0.1.0";
1.37 +
1.38 +# home-brewn getopt(3) style option parser
1.39 +sub getopts ($$@) {
1.40 + my ($opt_spec, $opts, @argv_orig) = @_;
1.41 + my (%optf) = map { m/(\w)/; $1 => $_ } $opt_spec =~ m/(\w:|\w)/g;
1.42 + my (@argv, $optarg);
1.43 +
1.44 + foreach (@argv_orig) {
1.45 + if (@argv) {
1.46 + push @argv, $_;
1.47 + } elsif (defined $optarg) {
1.48 + if (exists $opts->{$optarg}) {
1.49 + $opts->{$optarg} .= " $_";
1.50 + } else {
1.51 + $opts->{$optarg} = $_;
1.52 + }
1.53 + $optarg = undef;
1.54 + } elsif (!/^[-]/) {
1.55 + push @argv, $_;
1.56 + } else {
1.57 + while (/^\-(\w)(.*)/) {
1.58 + if (exists $optf{$1}) {
1.59 + if (length($optf{$1}) > 1) {
1.60 + if ($2 ne '') {
1.61 + if (exists $opts->{$1}) {
1.62 + $opts->{$1} .= " $2";
1.63 + } else {
1.64 + $opts->{$1} = $2;
1.65 + }
1.66 + } else {
1.67 + $optarg = $1;
1.68 + }
1.69 + last;
1.70 + } else {
1.71 + $opts->{$1} = 1;
1.72 + }
1.73 + } else {
1.74 + warn "openpkg:$prog_name:WARNING: unknown option $_\n";
1.75 + }
1.76 + $_ = "-$2";
1.77 + }
1.78 + }
1.79 + }
1.80 + if (defined $optarg) {
1.81 + warn "openpkg:$prog_name:WARNING: option $optarg requires an argument\n";
1.82 + }
1.83 + foreach my $opt (keys %optf) {
1.84 + if (not exists $opts->{$opt}) {
1.85 + $opts->{$opt} = (length($optf{$opt}) > 1 ? "" : 0);
1.86 + }
1.87 + }
1.88 + return @argv;
1.89 +}
1.90 +
1.91 +# execute a command
1.92 +my $run_cache = {};
1.93 +sub run ($) {
1.94 + my ($cmd) = @_;
1.95 + my $out = $run_cache->{$cmd};
1.96 + if (not defined($out)) {
1.97 + my @out = `$cmd`;
1.98 + $out = [ @out ];
1.99 + $run_cache->{$cmd} = $out;
1.100 + }
1.101 + return (wantarray ? @{$out} : join(//, @{$out}));
1.102 +}
1.103 +
1.104 +# determine reasonable temporary directory
1.105 +my $tmpdir = ($ENV{"TMPDIR"} || "/tmp");
1.106 +
1.107 +# parse command line options
1.108 +my $opts = {};
1.109 +@ARGV = getopts("hvr:", $opts, @ARGV);
1.110 +
1.111 +# usage sanity check and usage help
1.112 +sub usage {
1.113 + my ($rc) = @_;
1.114 + my $usage = "openpkg:$prog_name:USAGE: openpkg search <regex>\n";
1.115 + if ($rc == 0) {
1.116 + print STDOUT $usage;
1.117 + }
1.118 + else {
1.119 + print STDERR $usage;
1.120 + }
1.121 + exit($rc);
1.122 +}
1.123 +if ($opts->{"h"}) {
1.124 + usage(0);
1.125 +}
1.126 +if (@ARGV == 0) {
1.127 + usage(1);
1.128 +}
1.129 +
1.130 +# take command line arguments
1.131 +my $keyword = $ARGV[0];
1.132 +
1.133 +# determine start URL
1.134 +my $url = $opts->{"r"} || "";
1.135 +if ($url eq "") {
1.136 + $url = run("$my_prefix/bin/openpkg release --fmt='%u' 2>/dev/null");
1.137 + $url =~ s/^\s+//s;
1.138 + $url =~ s/\s+$//s;
1.139 +}
1.140 +if ($url eq "") {
1.141 + print STDERR "openpkg:$prog_name:ERROR: no repository URL known\n";
1.142 + exit(1);
1.143 +}
1.144 +
1.145 +# recursively download XML/RDF index
1.146 +sub relurl ($$) {
1.147 + my ($url, $suburl) = @_;
1.148 + if ($suburl =~ m/^\w+:\/\//) {
1.149 + $url = $suburl;
1.150 + }
1.151 + elsif ($suburl =~ m/^\//) {
1.152 + $url = "file://$suburl";
1.153 + }
1.154 + else {
1.155 + $url =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
1.156 + }
1.157 + 1 while ($url =~ s/\/\.\//\//s);
1.158 + 1 while ($url =~ s/\/[^\/]+\/\.\.\//\//s);
1.159 + return $url;
1.160 +}
1.161 +sub get_index ($) {
1.162 + my ($url) = @_;
1.163 + if ($url =~ m/^\//) {
1.164 + $url = "file://$url";
1.165 + }
1.166 + if ($url =~ m/\/$/) {
1.167 + $url .= "00INDEX.rdf";
1.168 + }
1.169 + my $cmd = "$my_prefix/bin/openpkg curl -s -o- \"$url\" 2>/dev/null";
1.170 + if ($url =~ m/\.bz2$/) {
1.171 + $cmd .= " | $my_prefix/lib/openpkg/bzip2 -d -c";
1.172 + }
1.173 + my $xml = run($cmd);
1.174 + my @includes = ();
1.175 + while ($xml =~ m/<Repository\s+[^>]*href="([^"]*)"/gs) {
1.176 + push(@includes, $1);
1.177 + }
1.178 + foreach my $include (@includes) {
1.179 + $xml .= get_index(relurl($url, $include));
1.180 + }
1.181 + return $xml;
1.182 +}
1.183 +my $xml = get_index($url);
1.184 +
1.185 +# parse XML/RDF index
1.186 +my $x = $xml;
1.187 +$x =~ s/<rdf:Description\s+about="([^"]+)".*?>(.+?)<\/rdf:Description>/do1($1, $2), ''/sge;
1.188 +sub do1 {
1.189 + my ($nvr, $xml) = @_;
1.190 + my ($name) = ($xml =~ m|<Name>(.+?)</Name>|s);
1.191 + my ($vers) = ($xml =~ m|<Version>(.+?)</Version>|s);
1.192 + my ($rele) = ($xml =~ m|<Release>(.+?)</Release>|s);
1.193 + my ($summ) = ($xml =~ m|<Summary>(.+?)</Summary>|s);
1.194 + my ($desc) = ($xml =~ m|<Description>(.+?)</Description>|s);
1.195 + if ( $name =~ m|$keyword|si
1.196 + or $summ =~ m|$keyword|si
1.197 + or $desc =~ m|$keyword|si) {
1.198 + do2($nvr, $name, $vers, $rele, $summ, $desc, $xml);
1.199 + }
1.200 +}
1.201 +sub do2 {
1.202 + my ($nvr, $name, $vers, $rele, $summ, $desc, $xml) = @_;
1.203 + return if ($name eq "openpkg");
1.204 + if ($opts->{"v"}) {
1.205 + # itemized verbose output
1.206 + my ($dist) = ($xml =~ m|<Distribution>(.+?)</Distribution>|s);
1.207 + my ($class) = ($xml =~ m|<Class>(.+?)</Class>|s);
1.208 + my ($group) = ($xml =~ m|<Group>(.+?)</Group>|s);
1.209 + my ($license) = ($xml =~ m|<License>(.+?)</License>|s);
1.210 + my ($packager) = ($xml =~ m|<Packager>(.+?)</Packager>|s);
1.211 + my ($url) = ($xml =~ m|<URL>(.+?)</URL>|s);
1.212 + my ($vendor) = ($xml =~ m|<Vendor>(.+?)</Vendor>|s);
1.213 +
1.214 + print "Name: $name\n";
1.215 + print "Version: $vers\n";
1.216 + print "Release: $rele\n";
1.217 + print "Group: $group\n";
1.218 + print "Class: $class\n";
1.219 + print "Distrib: $dist\n";
1.220 + print "License: $license\n";
1.221 + print "Packager: $packager\n";
1.222 + print "Vendor: $vendor\n";
1.223 + print "Summary: $summ\n";
1.224 + print "URL: $url\n";
1.225 +
1.226 + print "Description:\n";
1.227 + $desc =~ s/^\s+//mg;
1.228 + $desc =~ s/\s+$//mg;
1.229 + $desc =~ s/^/ /mg;
1.230 + print "$desc\n";
1.231 +
1.232 + my ($prov) = ($xml =~ m|<Provides>(.+?)</Provides>|s);
1.233 + if (($prov || "") ne "") {
1.234 + print "Provides:\n";
1.235 + $prov =~ s/<resource\s+equ="([^"]*)">(.+?)<\/resource>/do3($1, $2), ''/sge;
1.236 + sub do3 {
1.237 + my ($val, $name) = @_;
1.238 + print " $name = $val\n";
1.239 + }
1.240 + }
1.241 +
1.242 + print "\n";
1.243 + }
1.244 + else {
1.245 + # tabular brief output
1.246 + printf("%-20s %-10s %-9s %s\n", $name, $vers, $rele, $summ);
1.247 + }
1.248 +}
1.249 +
