my $thisscript = $Packages::HTML::SEARCH_CGI;
my $HOME = "http://www.debian.org";
-my $ROOT = "http://merkel.debian.org/~jeroen/pdo";
+my $ROOT = "";
my $SEARCHPAGE = "http://packages.debian.org/";
my @SUITES = qw( oldstable stable testing unstable experimental );
my @SECTIONS = qw( main contrib non-free );
my $debug_allowed = 1;
my $debug = $debug_allowed && $input->param("debug");
$debug = 0 if not defined($debug);
-$Search::Param::debug = 1 if $debug > 1;
+$Packages::Search::debug = 1 if $debug > 1;
# If you want, just print out a list of all of the variables and exit.
print $input->header if $debug;
}
}
-my %params_def = ( keywords => { default => undef, match => '^\s*([-+\@\w\/.:]+)\s*$' },
+my ( $format, $keyword, $case, $subword, $exact, $searchon,
+ @suites, @sections, @archs );
+
+my %params_def = ( keywords => { default => undef,
+ match => '^\s*([-+\@\w\/.:]+)\s*$',
+ var => \$keyword },
suite => { default => 'stable', match => '^(\w+)$',
alias => 'version', array => ',',
+ var => \@suites,
replace => { all => \@SUITES } },
- case => { default => 'insensitive', match => '^(\w+)$' },
- official => { default => 0, match => '^(\w+)$' },
- use_cache => { default => 1, match => '^(\w+)$' },
- subword => { default => 0, match => '^(\w+)$' },
- exact => { default => undef, match => '^(\w+)$' },
- searchon => { default => 'all', match => '^(\w+)$' },
+ case => { default => 'insensitive', match => '^(\w+)$',
+ var => \$case },
+# official => { default => 0, match => '^(\w+)$' },
+# use_cache => { default => 1, match => '^(\w+)$' },
+ subword => { default => 0, match => '^(\w+)$',
+ var => \$subword },
+ exact => { default => undef, match => '^(\w+)$',
+ var => \$exact },
+ searchon => { default => 'all', match => '^(\w+)$',
+ var => \$searchon },
section => { default => 'all', match => '^([\w-]+)$',
alias => 'release', array => ',',
+ var => \@sections,
replace => { all => \@SECTIONS } },
arch => { default => 'any', match => '^(\w+)$',
- array => ',', replace =>
+ array => ',', var => \@archs, replace =>
{ any => \@ARCHITECTURES } },
archive => { default => 'all', match => '^(\w+)$',
array => ',', replace =>
{ all => \@ARCHIVES } },
- format => { default => 'html', match => '^(\w+)$' },
+ format => { default => 'html', match => '^(\w+)$',
+ var => \$format },
);
-my %params = Packages::Search::parse_params( $input, \%params_def );
+my %opts;
+my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
-my $format = $params{values}{format}{final};
#XXX: Don't use alternative output formats yet
$format = 'html';
print "Error: keyword not valid or missing" if $format eq 'html';
exit 0;
}
-my $keyword = $params{values}{keywords}{final};
-my @suites = @{$params{values}{suite}{final}};
-my $official = $params{values}{official}{final};
-my $use_cache = $params{values}{use_cache}{final};
-my $case = $params{values}{case}{final};
+
my $case_bool = ( $case !~ /insensitive/ );
-my $subword = $params{values}{subword}{final};
-my $exact = $params{values}{exact}{final};
$exact = !$subword unless defined $exact;
-my $searchon = $params{values}{searchon}{final};
-my @sections = @{$params{values}{section}{final}};
-my @archs = @{$params{values}{arch}{final}};
-my $page = $params{values}{page}{final};
-my $results_per_page = $params{values}{number}{final};
-my %opts = ( case_bool => $case_bool, exact => $exact );
+$opts{h_suites} = { map { $_ => 1 } @suites };
+$opts{h_sections} = { map { $_ => 1 } @sections };
+$opts{h_archs} = { map { $_ => 1 } @archs };
# for URL construction
my $suites_param = join ',', @{$params{values}{suite}{no_replace}};
$search_on_sources = 1;
}
-my %suites = map { $_ => 1 } @suites;
-my %sections = map { $_ => 1 } @sections;
-my %archs = map { $_ => 1 } @archs;
-
-print "DEBUG: suites=@suites, sections=@sections, archs=@archs<br>"
- if $debug > 2;
-
sub read_entry {
- my ($hash, $key, $results) = @_;
- my $result = $hash->{$key};
+ my ($hash, $key, $results, $opts) = @_;
+ my $result = $hash->{$key} || '';
foreach (split /\000/, $result) {
my @data = split ( /\s/, $_, 7 );
print "DEBUG: Considering entry ".join( ':', @data)."<br>" if $debug > 2;
- if ($suites{$data[0]} && ($archs{$data[1]} || $data[1] eq 'all')
- && $sections{$data[2]}) {
+ if ($opts->{h_suites}{$data[0]}
+ && ($opts->{h_archs}{$data[1]} || $data[1] eq 'all')
+ && $opts->{h_sections}{$data[2]}) {
print "DEBUG: Using entry ".join( ':', @data)."<br>" if $debug > 2;
push @$results, [ $key, @data ];
}
}
}
sub read_src_entry {
- my ($hash, $key, $results) = @_;
- my $result = $hash->{$key};
-
+ my ($hash, $key, $results, $opts) = @_;
+ my $result = $hash->{$key} || '';
foreach (split /\000/, $result) {
my @data = split ( /\s/, $_, 5 );
print "DEBUG: Considering entry ".join( ':', @data)."<br>" if $debug > 2;
- if ($suites{$data[0]} && $sections{$data[1]}) {
+ if ($opts->{h_suites}{$data[0]} && $opts->{h_sections}{$data[1]}) {
print "DEBUG: Using entry ".join( ':', @data)."<br>" if $debug > 2;
push @$results, [ $key, @data ];
}
or die "couldn't tie DB $DBDIR/$file: $!";
if ($opts->{exact}) {
- &$read_entry( \%packages, $keyword, \@results );
+ &$read_entry( \%packages, $keyword, \@results, $opts );
} else {
my ($key, $prefixes) = ($keyword, '');
my %pkgs;
%pkgs = ( $keyword => 1 );
}
foreach my $pkg (sort keys %pkgs) {
- &$read_entry( \%packages, $pkg, \@results );
+ &$read_entry( \%packages, $pkg, \@results, $opts );
}
}
return \@results;
my $result = $did2pkg{$l};
foreach (split /\000/o, $result) {
my @data = split /\s/, $_, 3;
- next unless $archs{$data[2]};
+ next unless $opts->{h_archs}{$data[2]};
$tmp_results{$data[0]}++;
}
}
foreach my $pkg (keys %tmp_results) {
- &$read_entry( \%packages, $pkg, \@results );
+ &$read_entry( \%packages, $pkg, \@results, $opts );
}
return \@results;
}
+sub find_binaries {
+ my ($pkg, $suite) = @_;
+
+ tie my %src2bin, 'DB_File', "$DBDIR/sources_packages.db", O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't open $DBDIR/sources_packages.db: $!";
+
+ my $bins = $src2bin{$pkg} || '';
+ my %bins;
+ foreach (split /\000/o, $bins) {
+ my @data = split /\s/, $_, 4;
+
+ if ($data[0] eq $suite) {
+ $bins{$data[1]}++;
+ }
+ }
+
+ return [ keys %bins ];
+}
+
if ($searchon eq 'names') {
push @results, @{ do_names_search( $keyword, 'packages_small.db',
'package_postfixes.db',
$part{$package}{$suite}{$version} = $section unless $section eq 'main';
$desc{$package}{$suite}{$version} = $desc;
-
}
if ($format eq 'html') {
} else {
foreach (@results) {
my ($package, $suite, $section, $subsection, $priority,
- $version, $binaries) = @$_;
+ $version) = @$_;
$pkgs{$package}{$suite} = $version;
$sect{$package}{$suite}{source} = $subsection;
$part{$package}{$suite}{source} = $section unless $section eq 'main';
- $binaries{$package}{$suite} = [ sort split( /\s*,\s*/, $binaries ) ];
+ $binaries{$package}{$suite} = find_binaries( $package, $suite );
}
if ($format eq 'html') {
print "<br>Binary packages: ";
my @bp_links;
foreach my $bp (@{$binaries{$pkg}{$ver}}) {
- my $sect = 'section';
-
- my $bp_link;
- if ($sect) {
- $bp_link = sprintf( "<a href=\"$ROOT/%s/%s/%s\">%s</a>",
- $ver, $sect, uri_escape( $bp ), $bp );
- } else {
- $bp_link = $bp;
- }
+ my $bp_link = sprintf( "<a href=\"$ROOT/%s/%s\">%s</a>",
+ $ver, uri_escape( $bp ), $bp );
push @bp_links, $bp_link;
}
print join( ", ", @bp_links );
my $no_results = shift;
my $index_line;
- if ($no_results > $results_per_page) {
+ if ($no_results > $opts{number}) {
$index_line = prevlink($input,\%params)." | ".
indexline( $input, \%params, $no_results)." | ".
my $no_results = shift;
my ($start, $end);
- if ($results_per_page =~ /^all$/i) {
+ if ($opts{number} =~ /^all$/i) {
$start = 1;
$end = $no_results;
- $results_per_page = $no_results;
+ $opts{number} = $no_results;
} else {
$start = Packages::Search::start( \%params );
$end = Packages::Search::end( \%params );
print "<p>Results per page: ";
my @resperpagelinks;
for (50, 100, 200) {
- if ($results_per_page == $_) {
+ if ($opts{number} == $_) {
push @resperpagelinks, $_;
} else {
push @resperpagelinks, resperpagelink($input,\%params,$_);