michael@428: ##
michael@428: ##  search.pl -- OpenPKG Package Searching
michael@428: ##  Copyright (c) 2011-2012 OpenPKG GmbH <http://openpkg.com/>
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 <regex>\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/<Repository\s+[^>]*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\s+about="([^"]+)".*?>(.+?)<\/rdf:Description>/do1($1, $2), ''/sge;
michael@428: sub do1 {
michael@428:     my ($nvr, $xml) = @_;
michael@428:     my ($name) = ($xml =~ m|<Name>(.+?)</Name>|s);
michael@428:     my ($vers) = ($xml =~ m|<Version>(.+?)</Version>|s);
michael@428:     my ($rele) = ($xml =~ m|<Release>(.+?)</Release>|s);
michael@428:     my ($summ) = ($xml =~ m|<Summary>(.+?)</Summary>|s);
michael@428:     my ($desc) = ($xml =~ m|<Description>(.+?)</Description>|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|<Distribution>(.+?)</Distribution>|s);
michael@428:         my ($class)    = ($xml =~ m|<Class>(.+?)</Class>|s);
michael@428:         my ($group)    = ($xml =~ m|<Group>(.+?)</Group>|s);
michael@428:         my ($license)  = ($xml =~ m|<License>(.+?)</License>|s);
michael@428:         my ($packager) = ($xml =~ m|<Packager>(.+?)</Packager>|s);
michael@428:         my ($url)      = ($xml =~ m|<URL>(.+?)</URL>|s);
michael@428:         my ($vendor)   = ($xml =~ m|<Vendor>(.+?)</Vendor>|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|<Provides>(.+?)</Provides>|s);
michael@428:         if (($prov || "") ne "") {
michael@428:             print "Provides:\n";
michael@428:             $prov =~ s/<resource\s+equ="([^"]*)">(.+?)<\/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: