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