X-Git-Url: https://git.deb.at/?a=blobdiff_plain;f=cgi-bin%2Fshow_filelist.pl;fp=cgi-bin%2Fshow_filelist.pl;h=0000000000000000000000000000000000000000;hb=27d33ebb54f354d5d0d1fb68c94ff6a5682b54c3;hp=ffb93ee0fbf7e0045a724d375eceb293e02ab464;hpb=d9c10aaf0bb03bfb75404f9041967b9f91012bdb;p=deb%2Fpackages.git diff --git a/cgi-bin/show_filelist.pl b/cgi-bin/show_filelist.pl deleted file mode 100755 index ffb93ee..0000000 --- a/cgi-bin/show_filelist.pl +++ /dev/null @@ -1,123 +0,0 @@ -#!/usr/bin/perl -wT -# $Id$ -# show_package.pl -- CGI interface to show info about a package -# -# Copyright (C) 1998 James Treacy -# Copyright (C) 2000, 2001 Josip Rodin -# Copyright (C) 2001 Adam Heath -# Copyright (C) 2004 Martin Schulze -# Copyright (C) 2004-2006 Frank Lichtenheld -# Copyright (C) 2006 Jeroen van Wolffelaar -# -# use is allowed under the terms of the GNU Public License (GPL) -# see http://www.fsf.org/copyleft/gpl.html for a copy of the license - -use strict; -use lib '../lib'; -use CGI qw( -oldstyle_urls ); -use CGI::Carp qw( fatalsToBrowser ); -use POSIX; -use URI::Escape; -use HTML::Entities; -use DB_File; -use Benchmark ':hireswallclock'; - -use Deb::Versions; -use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS - @ARCHITECTURES %FTP_SITES ); -use Packages::CGI; -use Packages::DB; -use Packages::Search qw( :all ); -use Packages::HTML; -use Packages::Page (); -use Packages::SrcPage (); - -&Packages::CGI::reset; - -$ENV{PATH} = "/bin:/usr/bin"; - -# Read in all the variables set by the form -my $input; -if ($ARGV[0] && ($ARGV[0] eq 'php')) { - $input = new CGI(\*STDIN); -} else { - $input = new CGI; -} - -my $pet0 = new Benchmark; -my $tet0 = new Benchmark; -# use this to disable debugging in production mode completly -my $debug_allowed = 1; -my $debug = $debug_allowed && $input->param("debug"); -$debug = 0 if !defined($debug) || $debug !~ /^\d+$/o; -$Packages::CGI::debug = $debug; - -&Packages::Config::init( '../' ); -&Packages::DB::init(); - -my ( $pkg, $suite, $arch ); -my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$', - var => \$pkg }, - suite => { default => undef, match => '^(\w+)$', - var => \$suite }, - arch => { default => undef, match => '^([a-z0-9-]+)$', - var => \$arch } - ); - -my %opts; -my %params = Packages::Search::parse_params( $input, \%params_def, \%opts ); - -if ($params{errors}{package}) { - fatal_error( "package not valid or not specified" ); - $pkg = ''; -} -if ($params{errors}{suite}) { - fatal_error( "suite not valid or not specified" ); - $suite = ''; -} -if ($params{errors}{arch}) { - fatal_error( "arch not valid or not specified" ); - $arch = ''; -} - -print $input->header( -charset => 'utf-8' ); - -print Packages::HTML::header( title => "Filelist of package $pkg in $suite of arch $arch", - lang => 'en', - #desc => $short_desc, - #keywords => "$suite, $archive, $section, $subsection, $version", - #title_tag => "Details of package $pkg in $suite", - ); - -print_errors(); -print_hints(); -print_msgs(); -print_debug(); -print_notes(); - -unless (@Packages::CGI::fatal_errors) { - tie my %contents, 'DB_File', "$DBDIR/contents/filelists_${suite}_${arch}.db", - O_RDONLY, 0666, $DB_BTREE - or die "Invalid suite/arch combination"; - - print "No such package in this suite on this arch" if not exists $contents{$pkg}; - my @files = unpack "L/(CC/a)", $contents{$pkg}; - my $file = ""; - print "
";
-    for (my $i=0; $i";
-}
-
-my $tet1 = new Benchmark;
-my $tetd = timediff($tet1, $tet0);
-print "Total page evaluation took ".timestr($tetd)."
" - if $debug_allowed; - -my $trailer = Packages::HTML::trailer( $ROOT ); -$trailer =~ s/LAST_MODIFIED_DATE/gmtime()/e; #FIXME -print $trailer; - -# vim: ts=8 sw=4