lib/Packages/DoFilelist.pm

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