]> git.deb.at Git - deb/packages.git/blob - lib/Packages/DoIndex.pm
Merge commit 'origin/master' into debian-master
[deb/packages.git] / lib / Packages / DoIndex.pm
1 package Packages::DoIndex;
2
3 use strict;
4 use warnings;
5
6 use CGI qw( :cgi );
7 use Exporter;
8
9 use Deb::Versions;
10 use Packages::Config qw( $TOPDIR );
11 use Packages::I18N::Locale;
12 use Packages::CGI;
13
14 our @ISA = qw( Exporter );
15 our @EXPORT = qw( do_index do_allpackages );
16
17 sub do_index {
18     return send_file( 'index', @_ );
19 }
20 sub do_allpackages {
21     return send_file( 'allpackages', @_ );
22 }
23
24 my %encoding = (
25                 'txt.gz' => 'x-gzip',
26                 );
27 sub send_file {
28     my ($file, $params, $opts) = @_;
29
30     if ($params->{errors}{suite}) {
31         fatal_error( _g( "suite not valid or not specified" ) );
32     }
33     if (@{$opts->{suite}} > 1) {
34         fatal_error( sprintf( _g( "more than one suite specified for show_static (%s)" ), "@{$opts->{suite}}" ) );
35     }
36     if (@{$opts->{subsection}} > 1) {
37         fatal_error( sprintf( _g( "more than one suite specified for show_static (%s)" ), "@{$opts->{suite}}" ) );
38     }
39
40     my $wwwdir = "$TOPDIR/www";
41     my $path = "";
42     $path .= "source/" if $opts->{source};
43     $path .= "$opts->{suite}[0]/";
44     $path .= "$opts->{archive}[0]/" if @{$opts->{archive}} == 1;
45     $path .= "$opts->{subsection}[0]/" if @{$opts->{subsection}};
46     $path .= "$opts->{priority}[0]/" if @{$opts->{priority}};
47     # we don't have translated index pages for subsections yet
48     $opts->{lang} = 'en' if @{$opts->{subsection}} or $file eq 'allpackages';
49     $path .= "$file.$opts->{lang}.$opts->{format}";
50
51     unless (@Packages::CGI::fatal_errors) {
52         my $buffer;
53         if (open( INDEX, '<', "$wwwdir/$path" )) {
54             my %headers;
55             $headers{'-charset'} = get_charset( $opts->{lang} );
56             $headers{'-type'} = get_mime( $opts->{format}, 'text/plain' );
57             $headers{'-content-encoding'} = $encoding{$opts->{format}} if exists $encoding{$opts->{format}};
58             print header( %headers );
59
60             binmode INDEX;
61             while (read INDEX, $buffer, 4096) {
62                 print $buffer;
63             }
64             close INDEX;
65             exit;
66         } else {
67             fatal_error( sprintf( _g( "couldn't read index file %s: %s" ),
68                                   $path, $! ) );
69         }
70     }
71 }
72
73 1;
74