pkg-kde: commit - rev 31 - in people/jd: . scripts
Author: jd-guest
Date: 2004-02-11 22:18:39 +0100 (Wed, 11 Feb 2004)
New Revision: 31
Added:
people/jd/scripts/
people/jd/scripts/check-conflicts.pl
Log:
Add the check-conflicts script. This checks for conflicting files in
packages which are currently in stable, testing and unstable. Run it
from the source directory below the debian dir.
Bugs and features:
* You may need to edit if to change which Contents.gz file it uses.
* Does not check non-US Contents.gz
* Should print out additional conflicts in debian/control
* Speed. apt-file takes ~3s to iterate Contents.gz. This takes ~36s to
iterate the file 3 times.
Added: people/jd/scripts/check-conflicts.pl
===================================================================
--- people/jd/scripts/check-conflicts.pl 2004-02-11 20:18:42 UTC (rev 30)
+++ people/jd/scripts/check-conflicts.pl 2004-02-11 21:18:39 UTC (rev 31)
@@ -0,0 +1,135 @@
+#!/usr/bin/perl
+
+#
+# check-conflicts - Checks for conflicting files in packages currently
+# in stable, testing and unstable.
+#
+# (c) 2004 David Pashley <david@davidpashley.com>
+# $Id:$
+#
+#
+# This package 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; version 2 dated June, 1991.
+#
+# This package 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 package; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+#
+
+
+use warnings;
+use strict;
+use File::Find;
+use Data::Dumper;
+use Cwd;
+
+$|=1;
+
+my %filelist;
+my %conflicts;
+my %control_conflicts;
+my $dir = getcwd;
+
+sub dh_listpackages { # {{{
+ my @packages;
+ my $current_package;
+ open CONTROL, "debian/control" or die "could not open debian/control: $!\n";
+ while (<CONTROL>) {
+ chomp;
+ if (m/Package: (.*)$/) {
+ push @packages, $1;
+ $current_package = $1;
+ }
+ if (m/Conflicts: (.*)$/) {
+ my %temp;
+ for my $conflict ( split /, /, $1) {
+ $conflict =~ m/^([\-a-zA-Z0-9]+)( .*)?/;
+ $temp{$1} = $conflict;
+ }
+ $control_conflicts{$current_package} = \%temp;
+ }
+ }
+ close CONTROL;
+ return @packages;
+} # }}}
+
+sub load_filelists { # {{{
+
+ for my $package (dh_listpackages) {
+ find(\&wanted, "debian/$package");
+ }
+} # }}}
+
+sub wanted { # {{{
+ if (my ($package,$file) = $File::Find::name =~ m|debian/(.*?)/(.*)|) {
+ return if $file =~ m/^DEBIAN/;
+ return unless -f "$dir/$File::Find::name";
+ if (exists $filelist{$file}) {
+ print STDERR "$file is in $package and " .$filelist{$file} ."\n";
+ } else {
+ # TODO You may actually want this to be true.
+ $filelist{$file} = $package;
+ }
+ }
+} # }}}
+
+sub check_Contents { # {{{
+# Yes I kow it is hacky, but it is also the fastest method
+#Benchmark: timing 10 iterations of Compress::Zlib, IO::Zlib, zcat...
+#Compress::Zlib: 55 wallclock secs ( 54.84 usr + 0.19 sys = 55.03 CPU) @ 0.18/s (n=10)
+# IO::Zlib: 115 wallclock secs (114.48 usr + 0.20 sys = 114.68 CPU) @ 0.09/s (n=10)
+# zcat: 23 wallclock secs ( 14.10 usr 0.57 sys + 7.16 cusr 0.65 csys = 22.48 CPU) @ 0.68/s (n=10)
+ my $dist = shift;
+ my $contents ="/var/cache/apt/ftp.uk.debian.org_debian_dists_${dist}_Contents-i386.gz";
+ open ZCAT, "zcat $contents|" or die "could not open $contents: $!\n";
+ while (<ZCAT>){ last if m/^FILE /; } # Skip the preamble
+ my ($file, $packages);
+ while (my $line = <ZCAT>){
+ ($file) = $line =~ m/^(.*?)\s/;
+ if (exists $filelist{$file}) {
+ ($file, $packages) = $line =~ m/^(.*?)\s+(.*)$/;
+ my @packages;
+ for my $package (split /,/, $packages) {
+ $package =~ s#^.*/##;
+ push @packages, $package;
+ }
+ if (@packages = grep !/\Q$filelist{$file}\E/, @packages) {
+ #print $filelist{$file} . " conflicts with ". join (', ', @packages) . " $file\n";
+ for my $package (@packages) {
+ ${ $conflicts{ $filelist{$file} } }->{$package} = $dist;
+ }
+ }
+ }
+ }
+ close ZCAT;
+} # }}}
+
+
+load_filelists;
+
+print "parsing Contents.gz: ";
+for my $dist ("stable", "testing", "unstable") {
+ print "$dist ";
+ check_Contents $dist;
+}
+print "done\n";
+
+#print Dumper(\%conflicts);
+for my $package (sort keys %conflicts) {
+ print "$package:\n";
+ for my $pkg (sort keys %${$conflicts{$package}}) {
+ print "\tconflicts with $pkg in " . ${ $conflicts{ $package } }->{$pkg};
+ if (exists $control_conflicts{$package}->{$pkg}) {
+ print " currently listed as: $control_conflicts{$package}->{$pkg}";
+ }
+ print "\n";
+ }
+}
+
Property changes on: people/jd/scripts/check-conflicts.pl
___________________________________________________________________
Name: svn:executable
+ *
Reply to: