tag 229589 patch tag 319541 patch thanks This (rather immense) patch to dpkg-scanpackages.pl allows for multiple versions of a package in a Packages file (-m), outputing help, and fixes a rather insiduous bug in vercmp besides generally making the code far less insane than it was previously.
Don Armstrong -- Of course Pacman didn't influence us as kids. If it did, we'd be running around in darkened rooms, popping pills and listening to repetitive music. http://www.donarmstrong.com http://rzlab.ucr.edu
* finding or making [EMAIL PROTECTED]/dpkg--devel--1.13--base-0
* build reference tree for [EMAIL PROTECTED]/dpkg--devel--1.13--base-0
* finding or making [EMAIL PROTECTED]/dpkg--devel--1.13--patch-2
* computing changeset
A {arch}/dpkg/dpkg--devel/dpkg--devel--1.13/[EMAIL PROTECTED]/patch-log/patch-1
A {arch}/dpkg/dpkg--devel/dpkg--devel--1.13/[EMAIL PROTECTED]/patch-log/patch-2
M scripts/dpkg-scanpackages.pl
M debian/changelog
M ChangeLog
* changeset report
* modified files
--- orig/ChangeLog
+++ mod/ChangeLog
@@ -1,3 +1,13 @@
+2005-09-07 Don Armstrong <[EMAIL PROTECTED]>
+
+ * scripts/dpkg-scanpackages.pl: Rewrite the script to support
+ multiple versions of packages in a single Packages file; use
+ Getopt::Long instead of attempting to parse the command line
+ ourselves and doing it badly; get rid of unecessary hashes and
+ arrays that aren't used at all; output help when given the
+ --help/-h/-? options
+
+
2005-08-17 Scott James Remnant <[EMAIL PROTECTED]>
* configure.ac: Bump version to 1.13.12~.
--- orig/debian/changelog
+++ mod/debian/changelog
@@ -2,6 +2,12 @@
*
+ * Fixes to dpkg-dev (Don Armstrong)
+ - dpkg-scanpackages can now output Packages files with multiple
+ versions of a single package. Closes: #229589.
+ - dpkg-scanpackages outputs help when given the --help or -h option.
+ Closes: #319541
+
--
dpkg (1.13.11) unstable; urgency=low
--- orig/scripts/dpkg-scanpackages.pl
+++ mod/scripts/dpkg-scanpackages.pl
@@ -1,85 +1,104 @@
#!/usr/bin/perl
-$version= '1.2.6'; # This line modified by Makefile
+use warnings;
+use strict;
-%kmap= ('optional','suggests',
- 'recommended','recommends',
- 'class','priority',
- 'package_revision','revision');
-
[EMAIL PROTECTED] ('Package',
- 'Source',
- 'Version',
- 'Priority',
- 'Section',
- 'Essential',
- 'Maintainer',
- 'Pre-Depends',
- 'Depends',
- 'Recommends',
- 'Suggests',
- 'Conflicts',
- 'Provides',
- 'Replaces',
- 'Architecture',
- 'Filename',
- 'Size',
- 'Installed-Size',
- 'MD5sum',
- 'Description',
- 'Origin',
- 'Bugs');
-
-$written=0;
-$i=100; grep($pri{$_}=$i--,@fieldpri);
-
-$udeb = 0;
-$arch = '';
-while ($ARGV[0] =~ m/^-.*/) {
- my $opt = shift @ARGV;
- if ($opt eq '-u') {
- $udeb = 1;
- } elsif ($opt =~ m/-a(.*)/) {
- if ($1) {
- $arch = $1;
- } else {
- $arch = shift @ARGV;
- }
- } else {
- print STDERR "Unknown option($opt)!\n";
- exit(1);
- }
+use IO::Handle;
+use IO::File;
+
+my $version= '1.2.6'; # This line modified by Makefile
+
+my %kmap= (optional => 'suggests',
+ recommended => 'recommends',
+ class => 'priority',
+ package_revision => 'revision',
+ );
+
+my @fieldpri= ('Package',
+ 'Source',
+ 'Version',
+ 'Priority',
+ 'Section',
+ 'Essential',
+ 'Maintainer',
+ 'Pre-Depends',
+ 'Depends',
+ 'Recommends',
+ 'Suggests',
+ 'Conflicts',
+ 'Provides',
+ 'Replaces',
+ 'Architecture',
+ 'Filename',
+ 'Size',
+ 'Installed-Size',
+ 'MD5sum',
+ 'Description',
+ 'Origin',
+ 'Bugs'
+ );
+
+# This maps the fields into the proper case
+my %field_case;
[EMAIL PROTECTED]($_)} @fieldpri} = @fieldpri;
+
+use Getopt::Long;
+
+my %options = (help => 0,
+ udeb => 0,
+ arch => undef,
+ multiversion => 0,
+ );
+
+my $result =
GetOptions(\%options,'help|h|?','udeb|u!','arch|a=s','multiversion|m!');
+
+print <<END and exit 1 if not $result or $options{help} or @ARGV < 2;
+dpkg-scanpackages [-u] [-a<arch>] [-m] binarypath overridefile [pathprefix] >
Packages
+
+ Options:
+ --udeb, -u scan for udebs
+ --arch, -a architecture to scan for
+ --multiversion, -m allow multiple versions of a single package
+ --help, -h show this help
+
+END
+
+
+my $udeb = $options{udeb};
+my $arch = $options{arch};
+
+my $ext = $options{udeb} ? 'udeb' : 'deb';
+my @find_args;
+if ($options{arch}) {
+ @find_args = ('(','-name',"*_all.$ext",'-o','-name',"_${arch}.$ext",')',);
}
-$ext = $udeb ? 'udeb' : 'deb';
-$pattern = $arch ? "'(' -name '*_all.$ext' -o -name '*_$arch.$ext' ')'" :
"-name '*.$ext'";
-if ($ARGV[1] eq '-u') {
- $udeb = 1;
- shift @ARGV;
+else {
+ @find_args = ('-name',"*.$ext");
}
-
-$#ARGV == 1 || $#ARGV == 2
- or die "Usage: dpkg-scanpackages [-u] [-a<arch>] binarypath overridefile
[pathprefix] > Packages\n";
-($binarydir, $override, $pathprefix) = @ARGV;
+my ($binarydir, $override, $pathprefix) = @ARGV;
-d $binarydir or die "Binary dir $binarydir not found\n";
-e $override or die "Override file $override not found\n";
+$pathprefix = '' if not defined $pathprefix;
+
+our %vercache;
sub vercmp {
- ($a,$b)[EMAIL PROTECTED];
- return $vercache{$a,$b} if defined($vercache{$a,$b});
- system("dpkg --compare-versions $a le $b");
- $vercache{$a,$a}=$?;
- return $?;
+ my ($a,$b)[EMAIL PROTECTED];
+ return $vercache{$a}{$b} if exists $vercache{$a}{$b};
+ system('dpkg','--compare-versions',$a,'le',$b);
+ $vercache{$a}{$b}=$?;
+ return $?;
}
-# The extra slash causes symlinks to be followed.
-open(F,"find $binarydir/ -follow $pattern -print |")
- or die "Couldn't open pipe to find: $!\n";
-while (<F>) {
- chomp($fn=$_);
- substr($fn,0,length($binarydir)) eq $binarydir
- or die "$fn not in binary dir $binarydir\n";
- $t= `dpkg-deb -I $fn control`;
- if ($t eq "") {
+my %packages;
+my $find_h = new IO::Handle;
+open($find_h,'-|','find',"$binarydir/",@find_args,'-print')
+ or die "Couldn't open $binarydir for reading: $!\n";
+while (<$find_h>) {
+ chomp;
+ my $fn = $_;
+ my $control = `dpkg-deb -I $fn control`;
+ if ($control eq "") {
warn "Couldn't call dpkg-deb on $fn: $!, skipping package\n";
next;
}
@@ -88,44 +107,37 @@
next;
}
- undef %tv;
- $o= $t;
- while ($t =~ s/^\n*(\S+):[ \t]*(.*(\n[ \t].*)*)\n//) {
- $k= lc $1; $v= $2;
- if (defined($kmap{$k})) { $k= $kmap{$k}; }
- if (@kn= grep($k eq lc $_, @fieldpri)) {
- @kn==1 || die $k;
- $k= $kn[0];
- }
- $v =~ s/\s+$//;
- $tv{$k}= $v;
+ my %tv = ();
+ my $temp = $control;
+ while ($temp =~ s/^\n*(\S+):[ \t]*(.*(\n[ \t].*)*)\n//) {
+ my ($key,$value)= (lc $1,$2);
+ if (defined($kmap{$key})) { $key= $kmap{$key}; }
+ $value =~ s/\s+$//;
+ $tv{$field_case{$key}}= $value;
}
- $t =~ /^\n*$/
- or die "Unprocessed text from $fn control file; info:\n$o / $t\n";
+ $temp =~ /^\n*$/
+ or die "Unprocessed text from $fn control file; info:\n$control /
$temp\n";
defined($tv{'Package'})
or die "No Package field in control file of $fn\n";
- $p= $tv{'Package'}; delete $tv{'Package'};
+ my $p= $tv{'Package'}; delete $tv{'Package'};
- if (defined($p1{$p})) {
- if (&vercmp($tv{'Version'}, $pv{$p,'Version'})) {
+ if (defined($packages{$p}) and not $options{multiversion}) {
+ if (&vercmp($tv{'Version'}, $packages{$p}{'Version'})) {
print(STDERR " ! Package $p (filename $fn) is repeat but newer
version;\n".
- " used that one and ignored data from $pfilename{$p} !\n")
+ " used that one and ignored data from
$packages{$p}{Filename} !\n")
|| die $!;
- delete $p1{$p};
- for $k (keys %k1) {
- delete $pv{$p,$k};
- }
+ $packages{$p} = [];
} else {
print(STDERR " ! Package $p (filename $fn) is repeat;\n".
- " ignored that one and using data from
$pfilename{$p} !\n")
- || die $!;
+ " ignored that one and using data from
$packages{$p}{Filename} !\n")
+ or die $!;
next;
}
}
print(STDERR " ! Package $p (filename $fn) has Filename field!\n") || die
$!
if defined($tv{'Filename'});
-
+
$tv{'Filename'}= "$pathprefix$fn";
open(C,"md5sum <$fn |") || die "$fn $!";
@@ -133,109 +145,94 @@
/^([0-9a-f]{32})\s*-?\s*$/ or die "Strange text from \`md5sum < $fn':
\`$_'\n";
$tv{'MD5sum'}= $1;
- @stat= stat($fn) or die "Couldn't stat $fn: $!\n";
+ my @stat= stat($fn) or die "Couldn't stat $fn: $!\n";
$stat[7] or die "$fn is empty\n";
$tv{'Size'}= $stat[7];
- if (length($tv{'Revision'})) {
- $tv{'Version'}.= '-'.$tv{'Revision'};
- delete $tv{'Revision'};
- }
-
- for $k (keys %tv) {
- $pv{$p,$k}= $tv{$k};
- $k1{$k}= 1;
- $p1{$p}= 1;
+ if (defined $tv{Revision} and length($tv{Revision})) {
+ $tv{Version}.= '-'.$tv{Revision};
+ delete $tv{Revision};
}
- $_= substr($fn,length($binarydir));
- s#/[^/]+$##; s#^/*##;
- $psubdir{$p}= $_;
- $pfilename{$p}= $fn;
+ push @{$packages{$p}}, {%tv};
}
-close(F);
-$? and warn "find exited with $?\n";
+close($find_h);
select(STDERR); $= = 1000; select(STDOUT);
+sub writelist {
+ my $title= shift(@_);
+ return unless @_;
+
+ print(STDERR " $title\n") || die $!;
+ my $packages= join(' ',sort @_);
+
format STDERR =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$packages
.
-
-sub writelist {
- $title= shift(@_);
- return unless @_;
- print(STDERR " $title\n") || die $!;
- $packages= join(' ',sort @_);
while (length($packages)) { write(STDERR) || die $!; }
print(STDERR "\n") || die $!;
}
[EMAIL PROTECTED]();
+my (@samemaint,@changedmaint);
+
-open(O, $override)
+my %overridden;
+my $override_fh = new IO::File $override,'r'
or die "Couldn't open override file $override: $!\n";
-while (<O>) {
+while (<$override_fh>) {
s/\#.*//;
s/\s+$//;
- ($p,$priority,$section,$maintainer)= split(/\s+/,$_,4);
- next unless defined($p1{$p});
- if (length($maintainer)) {
- if ($maintainer =~ m/\s*=\>\s*/) {
- $oldmaint= $`; $newmaint= $'; $debmaint= $pv{$p,'Maintainer'};
- if (!grep($debmaint eq $_, split(m:\s*//\s*:, $oldmaint))) {
- push(@changedmaint,
- " $p (package says $pv{$p,'Maintainer'}, not
$oldmaint)\n");
- } else {
- $pv{$p,'Maintainer'}= $newmaint;
- }
- } elsif ($pv{$p,'Maintainer'} eq $maintainer) {
- push(@samemaint," $p ($maintainer)\n");
- } else {
- print(STDERR " * Unconditional maintainer override for $p *\n") ||
die $!;
- $pv{$p,'Maintainer'}= $maintainer;
- }
+ my ($p,$priority,$section,$maintainer)= split(/\s+/,$_,4);
+ next unless defined($packages{$p});
+ for my $package (@{$packages{$p}}) {
+ if (defined $maintainer and length($maintainer)) {
+ if ($maintainer =~ m/(.+?)\s*=\>\s*(.+)/) {
+ my $oldmaint= $1;
+ my $newmaint= $2;
+ my $debmaint= $$package{Maintainer};
+ if (!grep($debmaint eq $_, split(m:\s*//\s*:, $oldmaint))) {
+ push(@changedmaint,
+ " $p (package says $$package{Maintainer}, not
$oldmaint)\n");
+ } else {
+ $$package{Maintainer}= $newmaint;
+ }
+ }
+ } elsif ($$package{Maintainer} eq $maintainer) {
+ push(@samemaint," $p ($maintainer)\n");
+ } else {
+ print(STDERR " * Unconditional maintainer override for $p *\n")
|| die $!;
+ $$package{Maintainer}= $maintainer;
+ }
+ $packages{$p}{Priority}= $priority;
+ $packages{$p}{Section}= $section;
}
- $pv{$p,'Priority'}= $priority;
- $pv{$p,'Section'}= $section;
- ($sectioncut = $section) =~ s:^[^/]*/::;
- if (length($psubdir{$p}) && $section ne $psubdir{$p} &&
- $sectioncut ne $psubdir{$p}) {
- if (length($psubdir{$p}) && $section ne $psubdir{$p}) {
- print(STDERR " !! Package $p has \`Section: $section',".
- " but file is in \`$psubdir{$p}' !!\n") || die $!;
- $ouches++;
- }
- }
- $o1{$p}= 1;
+ $overridden{$p} = 1;
}
-close(O);
-print(STDERR "\n") || die $! if $ouches;
-
-$k1{'Maintainer'}= 1;
-$k1{'Priority'}= 1;
-$k1{'Section'}= 1;
+close($override_fh);
[EMAIL PROTECTED]();
+my @missingover=();
-for $p (sort keys %p1) {
- if (!defined($o1{$p})) {
+my $records_written = 0;
+for my $p (sort keys %packages) {
+ if (not defined($overridden{$p})) {
push(@missingover,$p);
}
- $r= "Package: $p\n";
- for $k (sort { $pri{$b} <=> $pri{$a} } keys %k1) {
- next unless length($pv{$p,$k});
- $r.= "$k: $pv{$p,$k}\n";
+ for my $package (@{$packages{$p}}) {
+ my $record= "Package: $p\n";
+ for my $key (@fieldpri) {
+ next unless defined $$package{$key};
+ $record .= "$key: $$package{$key}\n";
+ }
+ $record .= "\n";
+ $records_written++;
+ print(STDOUT $record) or die "Failed when writing stdout: $!\n";
}
- $r.= "\n";
- $written++;
- $p1{$p}= 1;
- print(STDOUT $r) or die "Failed when writing stdout: $!\n";
}
close(STDOUT) or die "Couldn't close stdout: $!\n";
[EMAIL PROTECTED] grep(!defined($p1{$_}),sort keys %o1);
+my @spuriousover= grep(!defined($packages{$_}),sort keys %overridden);
&writelist("** Packages in archive but missing from override file: **",
@missingover);
@@ -258,4 +255,4 @@
"\n") || die $!;
}
-print(STDERR " Wrote $written entries to output Packages file.\n") || die $!;
+print(STDERR " Wrote $records_written entries to output Packages file.\n") ||
die $!;
* added files
--- /dev/null
+++ mod/{arch}/dpkg/dpkg--devel/dpkg--devel--1.13/[EMAIL
PROTECTED]/patch-log/patch-1
@@ -0,0 +1,18 @@
+Revision: dpkg--devel--1.13--patch-1
+Archive: [EMAIL PROTECTED]
+Creator: Don Armstrong <[EMAIL PROTECTED]>
+Date: Wed Sep 7 22:51:21 PDT 2005
+Standard-date: 2005-09-08 05:51:21 GMT
+Modified-files: ChangeLog scripts/dpkg-scanpackages.pl
+New-patches: [EMAIL PROTECTED]/dpkg--devel--1.13--patch-1
+Summary: * scripts/dpkg-scanpackages.pl: Rewrite the script to support
+ multiple versions of packages in a single Packages file; use
+ Getopt::Long instead of attempting to parse the command line
+ ourselves and doing it badly; get rid of unecessary hashes and
+ arrays that aren't used at all.
+
+
+Keywords: scripts/dpkg-scanpackages.pl
+
+
+
--- /dev/null
+++ mod/{arch}/dpkg/dpkg--devel/dpkg--devel--1.13/[EMAIL
PROTECTED]/patch-log/patch-2
@@ -0,0 +1,13 @@
+Revision: dpkg--devel--1.13--patch-2
+Archive: [EMAIL PROTECTED]
+Creator: Don Armstrong <[EMAIL PROTECTED]>
+Date: Wed Sep 7 22:59:34 PDT 2005
+Standard-date: 2005-09-08 05:59:34 GMT
+Modified-files: ChangeLog debian/changelog
+ scripts/dpkg-scanpackages.pl
+New-patches: [EMAIL PROTECTED]/dpkg--devel--1.13--patch-2
+Summary: Added --help to dpkg-scanpackages (and -h and -?)
+Keywords: help,dpkg-scanpackages.pl
+
+
+
signature.asc
Description: Digital signature
