X-Git-Url: http://vcs.maemo.org/git/?a=blobdiff_plain;f=nokia-lintian%2Funpack%2Flist-srcpkg;fp=nokia-lintian%2Funpack%2Flist-srcpkg;h=9564f691ac35731cf424f52adf53f7c566a199f1;hb=1975b83207a518d59ef6b04c7c16233cb353ca86;hp=0000000000000000000000000000000000000000;hpb=208f636c44e0ec2b53c70aaed2399d8e9cf0e741;p=maemian diff --git a/nokia-lintian/unpack/list-srcpkg b/nokia-lintian/unpack/list-srcpkg new file mode 100755 index 0000000..9564f69 --- /dev/null +++ b/nokia-lintian/unpack/list-srcpkg @@ -0,0 +1,196 @@ +#!/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] \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 = } until ($line =~ m/^Directory: (.*)$/m); + my $pkg_dir = $1; + do { $line = } until ($line =~ m/^ [0-9a-f]{32} [0-9]+ (.+\.dsc)$/m); + my $dsc_file = "$pkg_dir/$1"; + do { $line = } 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