Replace non working volatile mirror debian.domainmail.org with mirror.csclub.uwaterloo.ca

[deb/packages.git] / lib / Packages / DoSearchContents.pm

diff --git a/lib/Packages/DoSearchContents.pm b/lib/Packages/DoSearchContents.pm
index f512ec4618334a3a007cd0492b8350e4ba7f8892..2316706f6bbf2c5b29738f43e755518cc9e4ffb6 100644 (file)
--- a/lib/Packages/DoSearchContents.pm
+++ b/lib/Packages/DoSearchContents.pm
@@ -5,8 +5,6 @@ use warnings;
 
 use Benchmark ':hireswallclock';
 use DB_File;
-use URI::Escape;
-use HTML::Entities;
 use Exporter;
 our @ISA = qw( Exporter );
 our @EXPORT = qw( do_search_contents );
@@ -14,31 +12,33 @@ our @EXPORT = qw( do_search_contents );
 use Deb::Versions;
 use Packages::I18N::Locale;
 use Packages::Search qw( :all );
-use Packages::CGI;
+use Packages::CGI qw( :DEFAULT error );
 use Packages::DB;
 use Packages::Config qw( $DBDIR @SUITES @ARCHIVES @ARCHITECTURES $ROOT );
 
 sub do_search_contents {
-    my ($params, $opts, $html_header, $page_content) = @_;
+    my ($params, $opts, $page_content) = @_;
+    my $cat = $opts->{cat};
 
     if ($params->{errors}{keywords}) {
-       fatal_error( _g( "keyword not valid or missing" ) );
+       fatal_error( $cat->g( "keyword not valid or missing" ) );
        $opts->{keywords} = [];
     } elsif (grep { length($_) < 2 } @{$opts->{keywords}}) {
-       fatal_error( _g( "keyword too short (keywords need to have at least two characters)" ) );
+       fatal_error( $cat->g( "keyword too short (keywords need to have at least two characters)" ) );
     }
     if ($params->{errors}{suite}) {
-       fatal_error( _g( "suite not valid or not specified" ) );
+       fatal_error( $cat->g( "suite not valid or not specified" ) );
     }
 
     #FIXME: that's extremely hacky atm
     if ($params->{values}{suite}{no_replace}[0] eq 'default') {
        $params->{values}{suite}{no_replace} =
-           $params->{values}{suite}{final} = $opts->{suite} = [ 'stable' ];
+           $params->{values}{suite}{final} = $opts->{suite} = [ 'etch' ];
     }
 
     if (@{$opts->{suite}} > 1) {
-       fatal_error( sprintf( _g( "more than one suite specified for contents search (%s)" ), "@{$opts->{suite}}" ) );
+       fatal_error( $cat->g( "more than one suite specified for contents search (%s)",
+                             "@{$opts->{suite}}" ) );
     }
 
     my @keywords = @{$opts->{keywords}};
@@ -58,6 +58,10 @@ sub do_search_contents {
        # full filename search is tricky
        my $ffn = $mode eq 'filename';
 
+       unless (-e "$DBDIR/contents/reverse_$suite.db") {
+           fatal_error($cat->g("No contents information available for this suite"));
+           return;
+       }
        my $reverses = tie my %reverses, 'DB_File', "$DBDIR/contents/reverse_$suite.db",
            O_RDONLY, 0666, $DB_BTREE
            or die "Failed opening reverse DB: $!";
@@ -75,14 +79,16 @@ sub do_search_contents {
                &searchfile(\@results, reverse($_)."/", \$nres, $reverses);
                last if $Packages::Search::too_many_hits;
            }
+           while (<FILENAMES>) {};
            close FILENAMES or warn "fgrep error: $!\n";
        } else {
 
-           error(_g("The search mode you selected doesn't support more than one keyword."))
+           error($cat->g("The search mode you selected doesn't support more than one keyword."))
                if @keywords;
 
            my $kw = reverse $first_kw;
-           
+           $kw =~ s{/+$}{};
+
            # exact filename searching follows trivially:
            $kw = "$kw/" if $mode eq 'exactfilename';
 
@@ -91,18 +97,18 @@ sub do_search_contents {
        $reverses = undef;
        untie %reverses;
 
-    
+
        my $st1 = new Benchmark;
        my $std = timediff($st1, $st0);
        debug( "Search took ".timestr($std) ) if DEBUG;
-    }    
+    }
 
     my (%results,%archs);
     foreach my $result (sort { $a->[0] cmp $b->[0] } @results) {
        my $file = shift @$result;
        my %pkgs;
        foreach (@$result) {
-           my ($pkg, $arch) = split /:/, $_;
+           my ($pkg, $arch) = split m/:/, $_;
            next unless $opts->{h_archs}{$arch};
            $pkgs{$pkg}{$arch}++;
            $archs{$arch}++ unless $arch eq 'all';
@@ -110,8 +116,8 @@ sub do_search_contents {
        next unless keys %pkgs;
        $results{$file} = \%pkgs;
     }
-    my @all_archs = keys %archs;
-    @all_archs = @ARCHITECTURES unless @all_archs;
+    my @all_archs = sort keys %archs;
+    @all_archs = sort @ARCHITECTURES unless @all_archs;
     $page_content->{suite} = $suite;
     $page_content->{archive} = $archive;
     $page_content->{all_architectures} = \@all_archs;
@@ -164,15 +170,22 @@ sub searchfile
     debug( "searchfile: kw=$kw", 1 ) if DEBUG;
     for (my $status = $reverses->seq($key, $value, R_CURSOR);
        $status == 0;
-       $status =  $reverses->seq( $key, $value, R_NEXT)) {
+       $status =  $reverses->seq( $key, $value, R_NEXT)) {
 
        # FIXME: what's the most efficient "is prefix of" thingy? We only want to know
        # whether $kw is or is not a prefix of $key
        last unless index($key, $kw) == 0;
        debug( "found $key", 2 ) if DEBUG;
 
-       my @hits = split /\0/o, $value;
-       push @$results, [ scalar reverse($key), @hits ];
+       my @files = split /\001/o, $value;
+       foreach my $f (@files) {
+           my @hits = split /\0/o, $f;
+           my $file = shift @hits;
+           if ($file eq '-') {
+               $file = reverse($key);
+           }
+           push @$results, [ $file, @hits ];
+       }
        last if ($$nres)++ > 100;
     }