]> git.deb.at Git - deb/packages.git/blob - lib/Packages/DoFilelist.pm
Merge commit 'origin/master' into debian-master
[deb/packages.git] / lib / Packages / DoFilelist.pm
1 package Packages::DoFilelist;
2
3 use strict;
4 use warnings;
5
6 use POSIX;
7 use URI::Escape;
8 use HTML::Entities;
9 use DB_File;
10 use Benchmark ':hireswallclock';
11 use Exporter;
12
13 use Deb::Versions;
14 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
15                          @ARCHITECTURES %FTP_SITES );
16 use Packages::I18N::Locale;
17 use Packages::CGI;
18 use Packages::DB;
19 use Packages::Search qw( :all );
20 use Packages::Page ();
21 use Packages::SrcPage ();
22
23 our @ISA = qw( Exporter );
24 our @EXPORT = qw( do_filelist );
25
26 sub do_filelist {
27     my ($params, $opts, $page_content) = @_;
28
29     if ($params->{errors}{package}) {
30         fatal_error( _g( "package not valid or not specified" ) );
31     }
32     if ($params->{errors}{suite}) {
33         fatal_error( _g( "suite not valid or not specified" ) );
34     }
35     if ($params->{errors}{arch}) {
36         fatal_error( _g( "architecture not valid or not specified" ) );
37     }
38
39     my $pkg = $opts->{package};
40     my $suite = $opts->{suite}[0];
41     my $arch = $opts->{arch}[0] ||'';
42     $page_content->{pkg} = $pkg;
43     $page_content->{suite} = $suite;
44     $page_content->{arch} = $arch;
45
46     unless (@Packages::CGI::fatal_errors) {
47         if (tie my %contents, 'DB_File', "$DBDIR/contents/filelists_${suite}_${arch}.db",
48             O_RDONLY, 0666, $DB_BTREE) {
49
50             unless (exists $contents{$pkg}) {
51                 fatal_error( _g( "No such package in this suite on this architecture." ) );
52             } else {
53                 my @files = unpack "L/(CC/a)", $contents{$pkg};
54                 my $file;
55
56                 $page_content->{files} = [];
57                 for (my $i=0; $i<scalar @files;) {
58                     $file = substr($file, 0, $files[$i++]).$files[$i++];
59                     push @{$page_content->{files}}, "/$file";
60                 }
61             }
62         } else {
63             fatal_error( _g( "Invalid suite/architecture combination" ) );
64         }
65     }
66 }
67
68 1;