michael@428: ##
michael@428: ## search.pl -- OpenPKG Package Searching
michael@428: ## Copyright (c) 2011-2012 OpenPKG GmbH
michael@428: ##
michael@428: ## This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
michael@428: ## All rights reserved. Licenses which grant limited permission to use,
michael@428: ## copy, modify and distribute this software are available from the
michael@428: ## OpenPKG GmbH.
michael@428: ##
michael@428: ## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
michael@428: ## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
michael@428: ## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
michael@428: ## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
michael@428: ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
michael@428: ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
michael@428: ## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
michael@428: ## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
michael@428: ## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
michael@428: ## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
michael@428: ## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
michael@428: ## SUCH DAMAGE.
michael@428: ##
michael@428:
michael@428: require 5.003;
michael@428:
michael@428: # OpenPKG instance prefix and RPM
michael@428: my $my_prefix = $ENV{'OPENPKG_PREFIX'};
michael@428: my $my_rpm = "$my_prefix/bin/openpkg rpm";
michael@428: delete $ENV{'OPENPKG_PREFIX'};
michael@428:
michael@428: # program identification
michael@428: my $progname = "search";
michael@428: my $progvers = "0.1.0";
michael@428:
michael@428: # home-brewn getopt(3) style option parser
michael@428: sub getopts ($$@) {
michael@428: my ($opt_spec, $opts, @argv_orig) = @_;
michael@428: my (%optf) = map { m/(\w)/; $1 => $_ } $opt_spec =~ m/(\w:|\w)/g;
michael@428: my (@argv, $optarg);
michael@428:
michael@428: foreach (@argv_orig) {
michael@428: if (@argv) {
michael@428: push @argv, $_;
michael@428: } elsif (defined $optarg) {
michael@428: if (exists $opts->{$optarg}) {
michael@428: $opts->{$optarg} .= " $_";
michael@428: } else {
michael@428: $opts->{$optarg} = $_;
michael@428: }
michael@428: $optarg = undef;
michael@428: } elsif (!/^[-]/) {
michael@428: push @argv, $_;
michael@428: } else {
michael@428: while (/^\-(\w)(.*)/) {
michael@428: if (exists $optf{$1}) {
michael@428: if (length($optf{$1}) > 1) {
michael@428: if ($2 ne '') {
michael@428: if (exists $opts->{$1}) {
michael@428: $opts->{$1} .= " $2";
michael@428: } else {
michael@428: $opts->{$1} = $2;
michael@428: }
michael@428: } else {
michael@428: $optarg = $1;
michael@428: }
michael@428: last;
michael@428: } else {
michael@428: $opts->{$1} = 1;
michael@428: }
michael@428: } else {
michael@428: warn "openpkg:$prog_name:WARNING: unknown option $_\n";
michael@428: }
michael@428: $_ = "-$2";
michael@428: }
michael@428: }
michael@428: }
michael@428: if (defined $optarg) {
michael@428: warn "openpkg:$prog_name:WARNING: option $optarg requires an argument\n";
michael@428: }
michael@428: foreach my $opt (keys %optf) {
michael@428: if (not exists $opts->{$opt}) {
michael@428: $opts->{$opt} = (length($optf{$opt}) > 1 ? "" : 0);
michael@428: }
michael@428: }
michael@428: return @argv;
michael@428: }
michael@428:
michael@428: # execute a command
michael@428: my $run_cache = {};
michael@428: sub run ($) {
michael@428: my ($cmd) = @_;
michael@428: my $out = $run_cache->{$cmd};
michael@428: if (not defined($out)) {
michael@428: my @out = `$cmd`;
michael@428: $out = [ @out ];
michael@428: $run_cache->{$cmd} = $out;
michael@428: }
michael@428: return (wantarray ? @{$out} : join(//, @{$out}));
michael@428: }
michael@428:
michael@428: # determine reasonable temporary directory
michael@428: my $tmpdir = ($ENV{"TMPDIR"} || "/tmp");
michael@428:
michael@428: # parse command line options
michael@428: my $opts = {};
michael@428: @ARGV = getopts("hvr:", $opts, @ARGV);
michael@428:
michael@428: # usage sanity check and usage help
michael@428: sub usage {
michael@428: my ($rc) = @_;
michael@428: my $usage = "openpkg:$prog_name:USAGE: openpkg search \n";
michael@428: if ($rc == 0) {
michael@428: print STDOUT $usage;
michael@428: }
michael@428: else {
michael@428: print STDERR $usage;
michael@428: }
michael@428: exit($rc);
michael@428: }
michael@428: if ($opts->{"h"}) {
michael@428: usage(0);
michael@428: }
michael@428: if (@ARGV == 0) {
michael@428: usage(1);
michael@428: }
michael@428:
michael@428: # take command line arguments
michael@428: my $keyword = $ARGV[0];
michael@428:
michael@428: # determine start URL
michael@428: my $url = $opts->{"r"} || "";
michael@428: if ($url eq "") {
michael@428: $url = run("$my_prefix/bin/openpkg release --fmt='%u' 2>/dev/null");
michael@428: $url =~ s/^\s+//s;
michael@428: $url =~ s/\s+$//s;
michael@428: }
michael@428: if ($url eq "") {
michael@428: print STDERR "openpkg:$prog_name:ERROR: no repository URL known\n";
michael@428: exit(1);
michael@428: }
michael@428:
michael@428: # recursively download XML/RDF index
michael@428: sub relurl ($$) {
michael@428: my ($url, $suburl) = @_;
michael@428: if ($suburl =~ m/^\w+:\/\//) {
michael@428: $url = $suburl;
michael@428: }
michael@428: elsif ($suburl =~ m/^\//) {
michael@428: $url = "file://$suburl";
michael@428: }
michael@428: else {
michael@428: $url =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
michael@428: }
michael@428: 1 while ($url =~ s/\/\.\//\//s);
michael@428: 1 while ($url =~ s/\/[^\/]+\/\.\.\//\//s);
michael@428: return $url;
michael@428: }
michael@428: sub get_index ($) {
michael@428: my ($url) = @_;
michael@428: if ($url =~ m/^\//) {
michael@428: $url = "file://$url";
michael@428: }
michael@428: if ($url =~ m/\/$/) {
michael@428: $url .= "00INDEX.rdf";
michael@428: }
michael@428: my $cmd = "$my_prefix/bin/openpkg curl -s -o- \"$url\" 2>/dev/null";
michael@428: if ($url =~ m/\.bz2$/) {
michael@428: $cmd .= " | $my_prefix/lib/openpkg/bzip2 -d -c";
michael@428: }
michael@428: my $xml = run($cmd);
michael@428: my @includes = ();
michael@428: while ($xml =~ m/]*href="([^"]*)"/gs) {
michael@428: push(@includes, $1);
michael@428: }
michael@428: foreach my $include (@includes) {
michael@428: $xml .= get_index(relurl($url, $include));
michael@428: }
michael@428: return $xml;
michael@428: }
michael@428: my $xml = get_index($url);
michael@428:
michael@428: # parse XML/RDF index
michael@428: my $x = $xml;
michael@428: $x =~ s/(.+?)<\/rdf:Description>/do1($1, $2), ''/sge;
michael@428: sub do1 {
michael@428: my ($nvr, $xml) = @_;
michael@428: my ($name) = ($xml =~ m|(.+?)|s);
michael@428: my ($vers) = ($xml =~ m|(.+?)|s);
michael@428: my ($rele) = ($xml =~ m|(.+?)|s);
michael@428: my ($summ) = ($xml =~ m|(.+?)|s);
michael@428: my ($desc) = ($xml =~ m|(.+?)|s);
michael@428: if ( $name =~ m|$keyword|si
michael@428: or $summ =~ m|$keyword|si
michael@428: or $desc =~ m|$keyword|si) {
michael@428: do2($nvr, $name, $vers, $rele, $summ, $desc, $xml);
michael@428: }
michael@428: }
michael@428: sub do2 {
michael@428: my ($nvr, $name, $vers, $rele, $summ, $desc, $xml) = @_;
michael@428: return if ($name eq "openpkg");
michael@428: if ($opts->{"v"}) {
michael@428: # itemized verbose output
michael@428: my ($dist) = ($xml =~ m|(.+?)|s);
michael@428: my ($class) = ($xml =~ m|(.+?)|s);
michael@428: my ($group) = ($xml =~ m|(.+?)|s);
michael@428: my ($license) = ($xml =~ m|(.+?)|s);
michael@428: my ($packager) = ($xml =~ m|(.+?)|s);
michael@428: my ($url) = ($xml =~ m|(.+?)|s);
michael@428: my ($vendor) = ($xml =~ m|(.+?)|s);
michael@428:
michael@428: print "Name: $name\n";
michael@428: print "Version: $vers\n";
michael@428: print "Release: $rele\n";
michael@428: print "Group: $group\n";
michael@428: print "Class: $class\n";
michael@428: print "Distrib: $dist\n";
michael@428: print "License: $license\n";
michael@428: print "Packager: $packager\n";
michael@428: print "Vendor: $vendor\n";
michael@428: print "Summary: $summ\n";
michael@428: print "URL: $url\n";
michael@428:
michael@428: print "Description:\n";
michael@428: $desc =~ s/^\s+//mg;
michael@428: $desc =~ s/\s+$//mg;
michael@428: $desc =~ s/^/ /mg;
michael@428: print "$desc\n";
michael@428:
michael@428: my ($prov) = ($xml =~ m|(.+?)|s);
michael@428: if (($prov || "") ne "") {
michael@428: print "Provides:\n";
michael@428: $prov =~ s/(.+?)<\/resource>/do3($1, $2), ''/sge;
michael@428: sub do3 {
michael@428: my ($val, $name) = @_;
michael@428: print " $name = $val\n";
michael@428: }
michael@428: }
michael@428:
michael@428: print "\n";
michael@428: }
michael@428: else {
michael@428: # tabular brief output
michael@428: printf("%-20s %-10s %-9s %s\n", $name, $vers, $rele, $summ);
michael@428: }
michael@428: }
michael@428: