cgi-bin/show_filelist.pl

   1 #!/usr/bin/perl -wT
   2 # $Id$
   3 # show_package.pl -- CGI interface to show info about a package
   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-2006 Frank Lichtenheld
  10 # Copyright (C) 2006 Jeroen van Wolffelaar
  11 #
  12 # use is allowed under the terms of the GNU Public License (GPL)
  13 # see http://www.fsf.org/copyleft/gpl.html for a copy of the license
  14
  15 use strict;
  16 use lib '../lib';
  17 use CGI qw( -oldstyle_urls );
  18 use CGI::Carp qw( fatalsToBrowser );
  19 use POSIX;
  20 use URI::Escape;
  21 use HTML::Entities;
  22 use DB_File;
  23 use Benchmark;
  24
  25 use Deb::Versions;
  26 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
  27                          @ARCHITECTURES %FTP_SITES );
  28 use Packages::CGI;
  29 use Packages::DB;
  30 use Packages::Search qw( :all );
  31 use Packages::HTML;
  32 use Packages::Page ();
  33 use Packages::SrcPage ();
  34
  35 &Packages::CGI::reset;
  36
  37 $ENV{PATH} = "/bin:/usr/bin";
  38
  39 # Read in all the variables set by the form
  40 my $input;
  41 if ($ARGV[0] && ($ARGV[0] eq 'php')) {
  42         $input = new CGI(\*STDIN);
  43 } else {
  44         $input = new CGI;
  45 }
  46
  47 my $pet0 = new Benchmark;
  48 my $tet0 = new Benchmark;
  49 # use this to disable debugging in production mode completly
  50 my $debug_allowed = 1;
  51 my $debug = $debug_allowed && $input->param("debug");
  52 $debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
  53 $Packages::CGI::debug = $debug;
  54
  55 &Packages::Config::init( '../' );
  56 &Packages::DB::init();
  57
  58 my ( $pkg, $suite, $arch );
  59 my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$',
  60                                 var => \$pkg },
  61                    suite => { default => undef, match => '^(\w+)$',
  62                               var => \$suite },
  63                    arch => { default => undef, match => '^([a-z0-9-]+)$',
  64                              var => \$arch }
  65                    );
  66
  67 my %opts;
  68 my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
  69
  70 if ($params{errors}{package}) {
  71     fatal_error( "package not valid or not specified" );
  72     $pkg = '';
  73 }
  74 if ($params{errors}{suite}) {
  75     fatal_error( "suite not valid or not specified" );
  76     $suite = '';
  77 }
  78 if ($params{errors}{arch}) {
  79     fatal_error( "arch not valid or not specified" );
  80     $arch = '';
  81 }
  82
  83 print $input->header( -charset => 'utf-8' );
  84
  85 print Packages::HTML::header( title => "Filelist of package $pkg in $suite of arch $arch",
  86                               lang => 'en',
  87                               #desc => $short_desc,
  88                               #keywords => "$suite, $archive, $section, $subsection, $version",
  89                               #title_tag => "Details of package $pkg in $suite",
  90                               );
  91
  92 print_errors();
  93 print_hints();
  94 print_msgs();
  95 print_debug();
  96 print_notes();
  97
  98 unless (@Packages::CGI::fatal_errors) {
  99     tie my %contents, 'DB_File', "$DBDIR/contents/filelists_${suite}_${arch}.db",
 100         O_RDONLY, 0666, $DB_BTREE
 101         or die "Invalid suite/arch combination";
 102
 103     print "No such package in this suite on this arch" if not exists $contents{$pkg};
 104     my @files = unpack "L/(CC/a)", $contents{$pkg};
 105     my $file = "";
 106     print "<pre>";
 107     for (my $i=0; $i<scalar @files;) {
 108             $file = substr($file, 0, $files[$i++]).$files[$i++];
 109             print "$file\n";
 110     }
 111     print "</pre>";
 112 }
 113
 114 my $tet1 = new Benchmark;
 115 my $tetd = timediff($tet1, $tet0);
 116 print "Total page evaluation took ".timestr($tetd)."<br>"
 117     if $debug_allowed;
 118
 119 my $trailer = Packages::HTML::trailer( $ROOT );
 120 $trailer =~ s/LAST_MODIFIED_DATE/gmtime()/e; #FIXME
 121 print $trailer;
 122
 123 # vim: ts=8 sw=4