3 # show_package.pl -- CGI interface to show info about a package
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
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
17 use CGI qw( -oldstyle_urls );
18 use CGI::Carp qw( fatalsToBrowser );
26 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
27 @ARCHITECTURES %FTP_SITES );
30 use Packages::Search qw( :all );
32 use Packages::Page ();
33 use Packages::SrcPage ();
35 &Packages::CGI::reset;
37 $ENV{PATH} = "/bin:/usr/bin";
39 # Read in all the variables set by the form
41 if ($ARGV[0] && ($ARGV[0] eq 'php')) {
42 $input = new CGI(\*STDIN);
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;
55 &Packages::Config::init( '../' );
56 &Packages::DB::init();
58 my ( $pkg, $suite, $arch );
59 my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$',
61 suite => { default => undef, match => '^(\w+)$',
63 arch => { default => undef, match => '^([a-z0-9-]+)$',
68 my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
70 if ($params{errors}{package}) {
71 fatal_error( "package not valid or not specified" );
74 if ($params{errors}{suite}) {
75 fatal_error( "suite not valid or not specified" );
78 if ($params{errors}{arch}) {
79 fatal_error( "arch not valid or not specified" );
83 print $input->header( -charset => 'utf-8' );
85 print Packages::HTML::header( title => "Filelist of package $pkg in $suite of arch $arch",
88 #keywords => "$suite, $archive, $section, $subsection, $version",
89 #title_tag => "Details of package $pkg in $suite",
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";
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};
107 for (my $i=0; $i<scalar @files;) {
108 $file = substr($file, 0, $files[$i++]).$files[$i++];
114 my $tet1 = new Benchmark;
115 my $tetd = timediff($tet1, $tet0);
116 print "Total page evaluation took ".timestr($tetd)."<br>"
119 my $trailer = Packages::HTML::trailer( $ROOT );
120 $trailer =~ s/LAST_MODIFIED_DATE/gmtime()/e; #FIXME