cgi-bin/search_packages.pl

   1 #!/usr/bin/perl -wT
   2 #
   3 # search_packages.pl -- CGI interface to the Packages files on packages.debian.org
   4 #
   5 # Copyright (C) 1998 James Treacy
   6 # Copyright (C) 2000, 2001 Josip Rodin
   7 # Copyright (C) 2001 Adam Heath
   8 # Copyright (C) 2004 Martin Schulze
   9 # Copyright (C) 2004 Frank Lichtenheld
  10 #
  11 # use is allowed under the terms of the GNU Public License (GPL)
  12 # see http://www.fsf.org/copyleft/gpl.html for a copy of the license
  13
  14 require 5.001;
  15 use strict;
  16 use CGI qw( -oldstyle_urls );
  17 #use CGI::Carp qw( fatalsToBrowser );
  18 use POSIX;
  19 use URI::Escape;
  20 use HTML::Entities;
  21 use DB_File;
  22 use Benchmark;
  23
  24 use lib "../lib";
  25
  26 use Deb::Versions;
  27 use Packages::Search qw( :all );
  28 use Packages::HTML ();
  29
  30 my $thisscript = "search_packages.pl";
  31 my $use_grep = 1;
  32 my $HOME = "http://www.debian.org";
  33 my $ROOT = "";
  34 my $SEARCHPAGE = "http://packages.debian.org/";
  35 my @SUITES = qw( oldstable stable testing unstable experimental );
  36 my @DISTS = @SUITES;
  37 my @SECTIONS = qw( main contrib non-free );
  38 my @ARCHIVES = qw( us security installer );
  39 my @ARCHITECTURES = qw( alpha amd64 arm hppa hurd-i386 i386 ia64
  40                         kfreebsd-i386 mips mipsel powerpc s390 sparc );
  41
  42 $ENV{PATH} = "/bin:/usr/bin";
  43
  44 # Read in all the variables set by the form
  45 my $input = new CGI;
  46
  47 my $pet0 = new Benchmark;
  48 # use this to disable debugging in production mode completly
  49 my $debug_allowed = 0;
  50 my $debug = $debug_allowed && $input->param("debug");
  51 $Search::Param::debug = 1 if $debug > 1;
  52
  53 # If you want, just print out a list of all of the variables and exit.
  54 print $input->header if $debug;
  55 # print $input->dump;
  56 # exit;
  57
  58 my %params_def = ( keywords => { default => undef, match => '^\s*([-+\@\w\/.:]+)\s*$' },
  59                    suite => { default => 'stable', match => '^(\w+)$',
  60                               alias => 'version', array => ',',
  61                               replace => { all => \@SUITES } },
  62                    case => { default => 'insensitive', match => '^(\w+)$' },
  63                    official => { default => 0, match => '^(\w+)$' },
  64                    use_cache => { default => 1, match => '^(\w+)$' },
  65                    subword => { default => 0, match => '^(\w+)$' },
  66                    exact => { default => undef, match => '^(\w+)$' },
  67                    searchon => { default => 'all', match => '^(\w+)$' },
  68                    section => { default => 'all', match => '^([\w-]+)$',
  69                                 alias => 'release', array => ',',
  70                                 replace => { all => \@SECTIONS } },
  71                    arch => { default => 'any', match => '^(\w+)$',
  72                              array => ',', replace =>
  73                              { any => \@ARCHITECTURES } },
  74                    archive => { default => 'all', match => '^(\w+)$',
  75                                 array => ',', replace =>
  76                                 { all => \@ARCHIVES } },
  77                    format => { default => 'html', match => '^(\w+)$' },
  78                    );
  79 my %params = Packages::Search::parse_params( $input, \%params_def );
  80
  81 my $format = $params{values}{format}{final};
  82 #XXX: Don't use alternative output formats yet
  83 $format = 'html';
  84
  85 if ($format eq 'html') {
  86     print $input->header;
  87 } elsif ($format eq 'xml') {
  88 #    print $input->header( -type=>'application/rdf+xml' );
  89     print $input->header( -type=>'text/plain' );
  90 }
  91
  92 if ($params{errors}{keywords}) {
  93     print "Error: keyword not valid or missing" if $format eq 'html';
  94     exit 0;
  95 }
  96 my $keyword = $params{values}{keywords}{final};
  97 my @suites = @{$params{values}{suite}{final}};
  98 my $official = $params{values}{official}{final};
  99 my $use_cache = $params{values}{use_cache}{final};
 100 my $case = $params{values}{case}{final};
 101 my $case_bool = ( $case !~ /insensitive/ );
 102 my $subword = $params{values}{subword}{final};
 103 my $exact = $params{values}{exact}{final};
 104 $exact = !$subword unless defined $exact;
 105 my $searchon = $params{values}{searchon}{final};
 106 my @sections = @{$params{values}{section}{final}};
 107 my @archs = @{$params{values}{arch}{final}};
 108 my $page = $params{values}{page}{final};
 109 my $results_per_page = $params{values}{number}{final};
 110
 111 # for URL construction
 112 my $suites_param = join ',', @{$params{values}{suite}{no_replace}};
 113 my $sections_param = join ',', @{$params{values}{section}{no_replace}};
 114 my $archs_param = join ',', @{$params{values}{arch}{no_replace}};
 115
 116 # for output
 117 my $keyword_enc = encode_entities $keyword;
 118 my $searchon_enc = encode_entities $searchon;
 119 my $suites_enc = encode_entities join ', ', @{$params{values}{suite}{no_replace}};
 120 my $sections_enc = encode_entities join ', ', @{$params{values}{section}{no_replace}};
 121 my $archs_enc = encode_entities join ', ',  @{$params{values}{arch}{no_replace}};
 122 my $pet1 = new Benchmark;
 123 my $petd = timediff($pet1, $pet0);
 124 print "DEBUG: Parameter evaluation took ".timestr($petd)."<br>" if $debug;
 125
 126 if ($format eq 'html') {
 127 print Packages::HTML::header( title => 'Package Search Results' ,
 128                               lang => 'en',
 129                               title_tag => 'Debian Package Search Results',
 130                               print_title_above => 1,
 131                               print_search_field => 'packages',
 132                               search_field_values => {
 133                                   keywords => $keyword_enc,
 134                                   searchon => $searchon,
 135                                   arch => $archs_enc,
 136                                   suite => $suites_enc,
 137                                   section => $sections_enc,
 138                                   subword => $subword,
 139                                   exact => $exact,
 140                                   case => $case,
 141                                   },
 142                               );
 143 }
 144
 145 # read the configuration
 146 my $topdir;
 147 if (!open (C, "../config.sh")) {
 148     print "\nInternal Error: Cannot open configuration file.\n\n" if $format eq 'html';
 149     exit 0;
 150 }
 151 while (<C>) {
 152     $topdir = $1 if (/^\s*topdir="?(.*)"?\s*$/);
 153 }
 154 close (C);
 155
 156 my $FLATDIR = $topdir . "/files/flat";
 157 my $search_on_sources = 0;
 158
 159 my %descr;
 160 my %sections;
 161
 162 sub find_desc
 163 {
 164     my $pkg = shift;
 165     my $suite = shift;
 166     my $part = shift;
 167     my $descr = '';
 168
 169     unless (exists $descr{$suite}{$part}) {
 170         $descr{$suite}{$part} = {};
 171         tie %{$descr{$suite}{$part}}, 'DB_File', "$FLATDIR/$suite/$part/Description", O_RDONLY
 172             or return "Error while loading descriptions database: $!";
 173     }
 174
 175     return $descr{$suite}{$part}{$pkg};
 176 }
 177
 178 sub find_section
 179 {
 180     my $pkg = shift;
 181     my $suite = shift;
 182     my $part = shift;
 183     my $section = '';
 184
 185     unless (exists $sections{$suite}{$part}) {
 186         $sections{$suite}{$part} = {};
 187         tie %{$sections{$suite}{$part}}, 'DB_File', "$FLATDIR/$suite/$part/Section", O_RDONLY
 188             or return undef;
 189     }
 190
 191     return $sections{$suite}{$part}{$pkg};
 192 }
 193
 194 my $st0 = new Benchmark;
 195 tie my %cache, 'DB_File', "$topdir/files/search.cache/search.cache", O_RDWR|O_CREAT or $use_cache = 0;
 196 my $cached;
 197 my @results;
 198 my $cache_key = $keyword.$exact.$subword.$searchon.$suites_param.$sections_param.$archs_param;
 199 if ($searchon eq 'sourcenames') {
 200     $search_on_sources = 1;
 201 }
 202 if ($use_cache && ($cached = $cache{$cache_key})) {
 203     @results = split /\n/, $cached;
 204     print "DEBUG: Used cached results<br><pre>$cached</pre>" if $debug;
 205 } else {
 206     my $searchkeyword = $keyword;
 207     my $grep_searchkeyword = $keyword;
 208     $searchkeyword =~ s/[.]/\\./;
 209     if (($searchon eq 'names') || ($searchon eq 'sourcenames')) {
 210         # asserting that all package names are lower case
 211         $searchkeyword = lc($searchkeyword) unless $case_bool;
 212         $case_bool = 1;
 213         $grep_searchkeyword = "^[^ ]*$searchkeyword" unless $exact;
 214         $searchkeyword = "^\\S*$searchkeyword" unless $exact;
 215     } else {
 216         $grep_searchkeyword = "\\(^$searchkeyword\\b\\|\\b$searchkeyword\\b\\)"
 217             if $subword != 1;
 218         $searchkeyword = "\\b$searchkeyword\\b"
 219             if $subword != 1;
 220     }
 221
 222 # FIXME
 223 # check if the Packages files are there
 224 #my @files = glob ("$fdir/$file");
 225 #if ($#files == -1) {
 226 # XXX has to be updated for new architectures
 227 #    if ($format eq 'html') {
 228 #       if (($version eq "stable" and $arch =~ /^(hurd|sh)$/)
 229 #           || ($version eq "oldstable" and $arch =~ /^amd64$/)) {
 230 #           print "Error: the $arch architecture didn't exist in $version.<br>\n"
 231 #               ."Please go back and choose a different distribution.\n";
 232 #       } else {
 233 #           print "Error: Packages/Sources file not found.<br>\n"
 234 #               ."If the problem persists, please inform $ENV{SERVER_ADMIN}.\n";
 235 #           printf "<p>$file</p>";
 236 #       }
 237 #       &printfooter;
 238 #    }
 239 #    exit;
 240 #}
 241
 242     my @files;
 243     foreach my $s (@suites) {
 244         foreach my $sec (@sections) {
 245             foreach my $a (@archs) {
 246                 foreach my $archive (@ARCHIVES) {
 247                     if (($searchon eq 'names' or $searchon eq 'sourcenames')
 248                         and $exact) {
 249                         my ( %packages, $file );
 250                         if ($search_on_sources) {
 251                             $file = "$FLATDIR/$s/$sec/Sources.$archive.db";
 252                         } else {
 253                             $file = "$FLATDIR/$s/$sec/Packages-$a.$archive.db";
 254                         }
 255                         if (-f $file) {
 256                             print "DEBUG: Use file $file<br>"
 257                                 if $debug > 1;
 258
 259                             tie %packages, 'DB_File', $file, O_RDONLY
 260                                 or die "Couldn't open packages file $file: $!";
 261
 262                             if (my $data = $packages{$searchkeyword}) {
 263                                 print "DEBUG: Found result $data<br>"
 264                                     if $debug > 1;
 265                                 push @results, "$file:$data";
 266                             }
 267                         }
 268                     } else {
 269                         my $file;
 270                         if ($search_on_sources) {
 271                             $file = "$FLATDIR/$s/$sec/Sources.$archive";
 272                         } else {
 273                             $file = "$FLATDIR/$s/$sec/Packages-$a.$archive";
 274                         }
 275                         if (-f $file) {
 276                             print "DEBUG: Use file $file<br>"
 277                                 if $debug > 1;
 278
 279                             # use_grep is currently way faster, though
 280                             # I can't pinpoint exactly why, yet
 281                             # most probably the perl regexes are
 282                             # slow compared to the simpler grep
 283                             # regexes
 284                             unless ($use_grep) {
 285                                 open my $pkg_fh, '<', $file
 286                                     or die "Couldn't open packages file $file: $!";
 287
 288                                 foreach (<$pkg_fh>) {
 289                                     if (/$searchkeyword/o) {
 290                                         print "DEBUG: Found result $_<br>"
 291                                             if $debug > 1;
 292
 293                                         push @results, "$file:$_";
 294                                     }
 295                                 }
 296                             } else {
 297                                 push @files, $file;
 298                             }
 299                         }
 300                     }
 301                 }
 302             }
 303         }
 304     }
 305
 306     if ($use_grep) {
 307         if (@files) {
 308             my @grep = ( 'grep', '-H' );
 309             push @grep, '-i' unless $case_bool;
 310             push @grep, $grep_searchkeyword;
 311             push @grep, @files;
 312
 313             print "DEBUG: starting grep command '".
 314                 substr("@grep",0,100)."[...]'<br>" if $debug;
 315             open my $grep_out, '-|', @grep or
 316                 die "grep failed: $!";
 317             @results = <$grep_out>;
 318         }
 319     }
 320
 321     $cache{$cache_key} = join "", @results;
 322 }
 323
 324 my $st1 = new Benchmark;
 325 my $std = timediff($st1, $st0);
 326 print "DEBUG: Search took ".timestr($std)."<br>" if $debug;
 327
 328 if ($format eq 'html') {
 329     my $suite_wording = $suites_enc eq "all" ? "all suites"
 330         : "suite(s) <em>$suites_enc</em>";
 331     my $section_wording = $sections_enc eq 'all' ? "all sections"
 332         : "section(s) <em>$sections_enc</em>";
 333     my $arch_wording = $archs_enc eq 'any' ? "all architectures"
 334         : "architecture(s) <em>$archs_enc</em>";
 335     if (($searchon eq "names") || ($searchon eq 'sourcenames')) {
 336         my $source_wording = $search_on_sources ? "source " : "";
 337         my $exact_wording = $exact ? "named" : "that names contain";
 338         print "<p>You have searched for ${source_wording}packages $exact_wording <em>$keyword_enc</em> in $suite_wording, $section_wording, and $arch_wording.</p>";
 339     } else {
 340         my $exact_wording = $exact ? "" : " (including subword matching)";
 341         print "<p>You have searched for <em>$keyword_enc</em> in packages names and descriptions in $suite_wording, $section_wording, and $arch_wording$exact_wording.</p>";
 342     }
 343 }
 344
 345 if (!@results) {
 346     if ($format eq 'html') {
 347         my $keyword_esc = uri_escape( $keyword );
 348         my $printed = 0;
 349         if (($searchon eq "names") || ($searchon eq 'sourcenames')) {
 350             if (($suites_enc eq 'all')
 351                 && ($archs_enc eq 'any')
 352                 && ($sections_enc eq 'all')) {
 353                 print "<p><strong>Can't find that package.</strong></p>\n";
 354             } else {
 355                 print "<p><strong>Can't find that package, at least not in that suite ".
 356                     ( $search_on_sources ? "" : " and on that architecture" ).
 357                     ".</strong></p>\n";
 358             }
 359
 360             if ($exact) {
 361                 $printed = 1;
 362                 print "<p>You have searched only for exact matches of the package name. You can try to search for <a href=\"$thisscript?exact=0&amp;searchon=$searchon&amp;suite=$suites_param&amp;case=$case&amp;section=$sections_param&amp;keywords=$keyword_esc&amp;arch=$archs_param\">package names that contain your search string</a>.</p>";
 363             }
 364         } else {
 365             if (($suites_enc eq 'all')
 366                 && ($archs_enc eq 'any')
 367                 && ($sections_enc eq 'all')) {
 368                 print "<p><strong>Can't find that string.</strong></p>\n";
 369             } else {
 370                 print "<p><strong>Can't find that string, at least not in that suite ($suites_enc, section $sections_enc) and on that architecture ($archs_enc).</strong></p>\n";
 371             }
 372
 373             unless ($subword) {
 374                 $printed = 1;
 375                 print "<p>You have searched only for words exactly matching your keywords. You can try to search <a href=\"$thisscript?subword=1&amp;searchon=$searchon&amp;suite=$suites_param&amp;case=$case&amp;section=$sections_param&amp;keywords=$keyword_esc&amp;arch=$archs_param\">allowing subword matching</a>.</p>";
 376             }
 377         }
 378         print "<p>".( $printed ? "Or you" : "You" )." can try a different search on the <a href=\"$SEARCHPAGE#search_packages\">Packages search page</a>.</p>";
 379
 380         &printfooter;
 381     }
 382     exit;
 383 }
 384
 385 my (%pkgs, %sect, %part, %desc, %binaries);
 386 my (@colon, $package, $pkg_t, $section, $ver, $arch, $foo, $binaries);
 387
 388 unless ($search_on_sources) {
 389     foreach my $line (@results) {
 390         @colon = split (/:/, $line);
 391         ($pkg_t, $section, $ver, $arch, $foo) = split (/ /, $#colon >1 ? $colon[1].":".$colon[2]:$colon[1], 5);
 392         $section =~ s,^(non-free|contrib)/,,;
 393         $section =~ s,^non-US.*$,non-US,,;
 394         my ($dist,$part,undef) = $colon[0] =~ m,.*/([^/]+)/([^/]+)/Packages-([^\.]+)\.,; #$1=stable, $2=main, $3=alpha
 395
 396         ($package) = $pkg_t =~ m/^(.+)/; # untaint
 397         $pkgs{$package}{$dist}{$ver}{$arch} = 1;
 398         $sect{$package}{$dist}{$ver} = $section;
 399         $part{$package}{$dist}{$ver} = $part unless $part eq 'main';
 400
 401         $desc{$package}{$dist}{$ver} = find_desc ($package, $dist, $part) if (! exists $desc{$package}{$dist}{$ver});
 402
 403     }
 404
 405     if ($format eq 'html') {
 406         my ($start, $end) = multipageheader( scalar keys %pkgs );
 407         my $count = 0;
 408
 409         foreach my $pkg (sort keys %pkgs) {
 410             $count++;
 411             next if $count < $start or $count > $end;
 412             printf "<h3>Package %s</h3>\n", $pkg;
 413             print "<ul>\n";
 414             foreach $ver (@SUITES) {
 415                 if (exists $pkgs{$pkg}{$ver}) {
 416                     my @versions = version_sort keys %{$pkgs{$pkg}{$ver}};
 417                     my $part_str = "";
 418                     if ($part{$pkg}{$ver}{$versions[0]}) {
 419                         $part_str = "[<span style=\"color:red\">$part{$pkg}{$ver}{$versions[0]}</span>]";
 420                     }
 421                     printf "<li><a href=\"$ROOT/%s/%s/%s\">%s</a> (%s): %s   %s\n",
 422                     $ver, $sect{$pkg}{$ver}{$versions[0]}, $pkg, $ver, $sect{$pkg}{$ver}{$versions[0]}, $desc{$pkg}{$ver}{$versions[0]}, $part_str;
 423
 424                     foreach my $v (@versions) {
 425                         printf "<br>%s: %s\n",
 426                         $v, join (" ", (sort keys %{$pkgs{$pkg}{$ver}{$v}}) );
 427                     }
 428                     print "</li>\n";
 429                 }
 430             }
 431             print "</ul>\n";
 432         }
 433     } elsif ($format eq 'xml') {
 434         require RDF::Simple::Serialiser;
 435         my $rdf = new RDF::Simple::Serialiser;
 436         $rdf->addns( debpkg => 'http://packages.debian.org/xml/01-debian-packages-rdf' );
 437         my @triples;
 438         foreach my $pkg (sort keys %pkgs) {
 439             foreach $ver (@DISTS) {
 440                 if (exists $pkgs{$pkg}{$ver}) {
 441                     my @versions = version_sort keys %{$pkgs{$pkg}{$ver}};
 442                     foreach my $version (@versions) {
 443                         my $id = "$ROOT/$ver/$sect{$pkg}{$ver}{$version}/$pkg/$version";
 444                         push @triples, [ $id, 'debpkg:package', $pkg ];
 445                         push @triples, [ $id, 'debpkg:version', $version ];
 446                         push @triples, [ $id, 'debpkg:section', $sect{$pkg}{$ver}{$version}, ];
 447                         push @triples, [ $id, 'debpkg:suite', $ver ];
 448                         push @triples, [ $id, 'debpkg:shortdesc', $desc{$pkg}{$ver}{$version} ];
 449                         push @triples, [ $id, 'debpkg:part', $part{$pkg}{$ver}{$version} || 'main' ];
 450                         foreach my $arch (sort keys %{$pkgs{$pkg}{$ver}{$version}}) {
 451                             push @triples, [ $id, 'debpkg:architecture', $arch ];
 452                         }
 453                     }
 454                 }
 455             }
 456         }
 457
 458         print $rdf->serialise(@triples);
 459     }
 460 } else {
 461     foreach my $line (@results) {
 462         chomp($line);
 463         @colon = split (/:/, $line);
 464         ($package, $section, $ver, $binaries) = split (/ /, $#colon >1 ? $colon[1].":".$colon[2]:$colon[1], 4);
 465         $section =~ s,^(non-free|contrib)/,,;
 466         $section =~ s,^non-US.*$,non-US,,;
 467         $colon[0] =~ m,.*/([^/]+)/([^/]+)/Sources\.,; #$1=stable, $2=main
 468
 469         my ($suite, $part) = ($1, $2);
 470         $pkgs{$package}{$suite} = $ver;
 471         $sect{$package}{$suite}{source} = $section;
 472         $part{$package}{$suite}{source} = $part unless $part eq 'main';
 473
 474         $binaries{$package}{$suite} = [ sort split( /\s*,\s*/, $binaries ) ];
 475
 476     }
 477
 478     if ($format eq 'html') {
 479         my ($start, $end) = multipageheader( scalar keys %pkgs );
 480         my $count = 0;
 481
 482         foreach my $pkg (sort keys %pkgs) {
 483             $count++;
 484             next if ($count < $start) or ($count > $end);
 485             printf "<h3>Source package %s</h3>\n", $pkg;
 486             print "<ul>\n";
 487             foreach $ver (@DISTS) {
 488                 if (exists $pkgs{$pkg}{$ver}) {
 489                     my $part_str = "";
 490                     if ($part{$pkg}{$ver}{source}) {
 491                         $part_str = "[<span style=\"color:red\">$part{$pkg}{$ver}{source}</span>]";
 492                     }
 493                     printf "<li><a href=\"$ROOT/%s/source/%s\">%s</a> (%s): %s   %s", $ver, $pkg, $ver, $sect{$pkg}{$ver}{source}, $pkgs{$pkg}{$ver}, $part_str;
 494
 495                     print "<br>Binary packages: ";
 496                     my @bp_links;
 497                     foreach my $bp (@{$binaries{$pkg}{$ver}}) {
 498                         my $sect = find_section($bp, $ver, $part{$pkg}{$ver}{source}||'main') || '';
 499                         $sect =~ s,^(non-free|contrib)/,,;
 500                         $sect =~ s,^non-US.*$,non-US,,;
 501                         my $bp_link;
 502                         if ($sect) {
 503                             $bp_link = sprintf "<a href=\"$ROOT/%s/%s/%s\">%s</a>", $ver, $sect, uri_escape( $bp ),  $bp;
 504                         } else {
 505                             $bp_link = $bp;
 506                         }
 507                         push @bp_links, $bp_link;
 508                     }
 509                     print join( ", ", @bp_links );
 510                     print "</li>\n";
 511                 }
 512             }
 513             print "</ul>\n";
 514         }
 515     } elsif ($format eq 'xml') {
 516         require RDF::Simple::Serialiser;
 517         my $rdf = new RDF::Simple::Serialiser;
 518         $rdf->addns( debpkg => 'http://packages.debian.org/xml/01-debian-packages-rdf' );
 519         my @triples;
 520         foreach my $pkg (sort keys %pkgs) {
 521             foreach $ver (@DISTS) {
 522                 if (exists $pkgs{$pkg}{$ver}) {
 523                     my $id = "$ROOT/$ver/source/$pkg";
 524
 525                     push @triples, [ $id, 'debpkg:package', $pkg ];
 526                     push @triples, [ $id, 'debpkg:type', 'source' ];
 527                     push @triples, [ $id, 'debpkg:section', $sect{$pkg}{$ver}{source} ];
 528                     push @triples, [ $id, 'debpkg:version', $pkgs{$pkg}{$ver} ];
 529                     push @triples, [ $id, 'debpkg:part', $part{$pkg}{$ver}{source} || 'main' ];
 530
 531                     foreach my $bp (@{$binaries{$pkg}{$ver}}) {
 532                         push @triples, [ $id, 'debpkg:binary', $bp ];
 533                     }
 534                 }
 535             }
 536         }
 537         print $rdf->serialise(@triples);
 538     }
 539 }
 540
 541 if ($format eq 'html') {
 542     &printindexline( scalar keys %pkgs );
 543     &printfooter;
 544 }
 545
 546 exit;
 547
 548 sub printindexline {
 549     my $no_results = shift;
 550
 551     my $index_line;
 552     if ($no_results > $results_per_page) {
 553
 554         $index_line = prevlink($input,\%params)." | ".indexline( $input, \%params, $no_results)." | ".nextlink($input,\%params, $no_results);
 555
 556         print "<p style=\"text-align:center\">$index_line</p>";
 557     }
 558 }
 559
 560 sub multipageheader {
 561     my $no_results = shift;
 562
 563     my ($start, $end);
 564     if ($results_per_page =~ /^all$/i) {
 565         $start = 1;
 566         $end = $no_results;
 567         $results_per_page = $no_results;
 568     } else {
 569         $start = Packages::Search::start( \%params );
 570         $end = Packages::Search::end( \%params );
 571         if ($end > $no_results) { $end = $no_results; }
 572     }
 573
 574     print "<p>Found <em>$no_results</em> matching packages,";
 575     if ($end == $start) {
 576         print " displaying package $end.</p>";
 577     } else {
 578         print " displaying packages $start to $end.</p>";
 579     }
 580
 581     printindexline( $no_results );
 582
 583     if ($no_results > 100) {
 584         print "<p>Results per page: ";
 585         my @resperpagelinks;
 586         for (50, 100, 200) {
 587             if ($results_per_page == $_) {
 588                 push @resperpagelinks, $_;
 589             } else {
 590                 push @resperpagelinks, resperpagelink($input,\%params,$_);
 591             }
 592         }
 593         if ($params{values}{number}{final} =~ /^all$/i) {
 594             push @resperpagelinks, "all";
 595         } else {
 596             push @resperpagelinks, resperpagelink($input, \%params,"all");
 597         }
 598         print join( " | ", @resperpagelinks )."</p>";
 599     }
 600     return ( $start, $end );
 601 }
 602
 603 sub printfooter {
 604 print <<END;
 605 </div>
 606
 607 <hr class="hidecss">
 608 <p style="text-align:right;font-size:small;font-stlye:italic"><a href="$SEARCHPAGE">Packages search page</a></p>
 609
 610 </div>
 611 END
 612
 613 print $input->end_html;
 614 }