+++ /dev/null
-#!/usr/bin/perl -w
-# list-srcpkg -- lintian helper script
-
-# Copyright (C) 1998 Christian Schwarz
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program. If not, you can find it on the World Wide
-# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
-# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
-# MA 02110-1301, USA.
-
-use strict;
-
-# turn file buffering off:
-$| = 1;
-
-# parse command line options
-if ($#ARGV == -1) {
- print "list-srcpkg [-v] <output-list-file>\n";
- print "options:\n";
- print " -v verbose\n";
- exit 0;
-}
-
-my $verbose = 0;
-my $output_file = undef;
-
-while (my $arg = shift) {
- if ($arg =~ s,^-,,o) {
- if ($arg eq 'v') {
- $verbose = 1;
- } else {
- print STDERR "error: unknown command line argument: $arg\n";
- exit 1;
- }
- } else {
- if ($output_file) {
- print STDERR "error: too many command line arguments: $arg\n";
- exit 1;
- }
- $output_file = $arg;
- }
-}
-unless ($output_file) {
- print STDERR "error: no output file specified\n";
- exit 1;
-}
-
-# import perl libraries
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Read_pkglists;
-use vars qw(%source_info $SRCLIST_FORMAT); # from the above
-use Util;
-
-# get variables out of environment
-my $LINTIAN_ARCHIVEDIR = $ENV{'LINTIAN_ARCHIVEDIR'};
-my $LINTIAN_DIST = $ENV{'LINTIAN_DIST'};
-my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
-my $LINTIAN_SECTION = $ENV{'LINTIAN_SECTION'};
-
-# read old list file (this command does nothing if the file does not exist)
-read_src_list($output_file,1);
-
-my %pkgfile;
-# map filenames to package names
-for my $pkg (keys %source_info) {
- $pkgfile{$source_info{$pkg}->{'file'}} = $pkg;
-}
-
-# open output file
-open(OUT, '>', $output_file) or fail("cannot open list file $output_file for writing: $!");
-print OUT "$SRCLIST_FORMAT\n";
-
-# parse Sources.gz to get list of packages
-my $sources = "$LINTIAN_ARCHIVEDIR/dists/$LINTIAN_DIST/$LINTIAN_SECTION/source/Sources.gz";
-print "N: Parsing $sources ...\n" if $verbose;
-open(IN, '-|', 'zcat', $sources) or fail("Cannot open input pipe from zcat $sources: $!");
-
-my $line;
-my %packages;
-my $total = 0;
-
-while (!eof(IN)) {
- do { $line = <IN> } until ($line =~ m/^Directory: (.*)$/m);
- my $pkg_dir = $1;
- do { $line = <IN> } until ($line =~ m/^ [0-9a-f]{32} [0-9]+ (.+\.dsc)$/m);
- my $dsc_file = "$pkg_dir/$1";
- do { $line = <IN> } until ($line =~ m/^\s*$/m);
-
- my @stat;
- # get timestamp...
- unless (@stat = stat "$LINTIAN_ARCHIVEDIR/$dsc_file") {
- warn "E: general: cannot stat file $LINTIAN_ARCHIVEDIR/$dsc_file: $!\n";
- next;
- }
- my $timestamp = $stat[9];
-
- my ($status,$pkg,$data);
-
- # was package already included in last list?
- if (exists $pkgfile{$dsc_file}) {
- # yes!
- $pkg = $pkgfile{$dsc_file};
- $data = $source_info{$pkg};
-
- # file changed since last run?
- if ($timestamp == $data->{'timestamp'}) {
- # no.
- $status = 'unchanged';
- } else {
- $status = 'changed';
- delete $source_info{$pkg};
- }
- } else {
- # new package, get info
- $status = 'new';
- }
-
- if (($status eq 'new') or ($status eq 'changed')) {
- # use eval when calling get_dsc_info, since we don't want to `die' just
- # because of a single broken package
- eval { $data = get_dsc_info("$LINTIAN_ARCHIVEDIR/$dsc_file"); };
- if ($@) {
- # error!
- print STDERR "$@\n";
- print "E: general: bad-source-package $dsc_file\n";
- next;
- }
- my @f = ();
- for my $fs (split(/\n/,$data->{'files'})) {
- next if $fs =~ /^\s*$/o;
- my @t = split(/\s+/o,$fs);
- push(@f,$t[2]);
- }
- $data->{'files'} = join(',',@f);
- $data->{'standards-version'} ||= "";
- $pkg = $data->{'source'};
- }
-
- # check for duplicates
- if (exists $packages{$pkg}) {
- print "E: general: duplicate-source-package $pkg\n";
- next;
- }
-
- # write entry to output file
- for (qw/version maintainer uploaders architecture standards-version binary files/) {
- $data->{$_} =~ tr/;\n/_ / if $data->{$_};
- }
- print OUT join(';',
- $pkg,
- $data->{'version'},
- $data->{'maintainer'},
- $data->{'uploaders'} || '',
- $data->{'architecture'},
- $data->{'standards-version'},
- $data->{'binary'},
- $data->{'files'},
- $dsc_file,
- $timestamp,
- ),"\n";
- printf "N: Listed %s source package %s %s\n",$status,$pkg,$data->{'version'} if $verbose;
-
- # remove record from hash
- delete $source_info{$pkg} if $status eq 'unchanged';
- $packages{$pkg} = 1;
- $total++;
-}
-close(IN) or fail("cannot close input pipe: $!");
-close(OUT) or fail("cannot close output pipe: $!");
-
-if ($verbose) {
- # all packages that are still included in %source_info have disappeared from the archive...
- for my $pkg (sort keys %source_info) {
- print "N: Removed source package $pkg from list\n";
- }
- printf "N: Listed %d source packages\n",$total;
-}
-
-exit 0;
-
-# Local Variables:
-# indent-tabs-mode: nil
-# cperl-indent-level: 2
-# End:
-# vim: syntax=perl sw=2 sts=2 ts=2 et shiftround
projects / maemian / blobdiff