The following commit has been merged in the master branch:
commit 7ebf1f067d4345e4969d858667e2da0a321b1716
Author: James McCoy <[email protected]>
Date: Sat Jun 30 09:56:25 2012 -0400
Devscripts/*.pm: Parse dpkg's status file using Dpkg::Control.
Signed-off-by: James McCoy <[email protected]>
diff --git a/Devscripts/PackageDeps.pm b/Devscripts/PackageDeps.pm
index a02cf2a..5236d7e 100644
--- a/Devscripts/PackageDeps.pm
+++ b/Devscripts/PackageDeps.pm
@@ -20,11 +20,12 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
+package Devscripts::PackageDeps;
use strict;
use Carp;
+use Dpkg::Control;
require 5.006_000;
-package Devscripts::PackageDeps;
# This reads in a package file list, such as /var/lib/dpkg/status,
# and parses it.
@@ -62,27 +63,27 @@ sub parse ($$)
open PACKAGE_FILE, $filename or
croak("Unable to load $filename: $!");
- local $/;
- $/=""; # Split on blank lines
-
+ my $ctrl;
PACKAGE_ENTRY:
- while (<PACKAGE_FILE>) {
- if (/^\s*$/) { next; }
+ while (defined($ctrl = Dpkg::Control->new(type => CTRL_FILE_STATUS))
+ && $ctrl->parse(\*PACKAGE_FILE, $filename)) {
# So we've got a package
- my $pkg;
+ my $pkg = $ctrl->{Package};
my @deps = ();
- chomp;
- s/\n\s+/\376\377/g; # fix continuation lines
- s/\376\377\s*\376\377/\376\377/og;
+ if ($ctrl->{Status} =~ /^\S+\s+\S+\s+(\S+)$/) {
+ my $status = $1;
+ unless ($status eq 'installed' or $status eq 'unpacked') {
+ undef $ctrl;
+ next PACKAGE_ENTRY;
+ }
+ }
- while (/^(\S+):\s*(.*?)\s*$/mg) {
- my ($key, $value) = (lc $1, $2);
- $value =~ s/\376\377/\n /g;
- if ($key eq 'package') { $pkg = $value; }
- elsif ($key =~ /^(pre-)?depends$/) {
- $value =~ s/\(.*?\)//g; # ignore versioning information
+ for my $dep (qw(Depends Pre-Depends)) {
+ if (exists $ctrl->{$dep}) {
+ my $value = $ctrl->{$dep};
+ $value =~ s/\([^)]+\)//g; # ignore versioning information
$value =~ tr/ \t//d; # remove spaces
my @dep_pkgs = split /,/, $value;
foreach my $dep_pkg (@dep_pkgs) {
@@ -91,19 +92,10 @@ sub parse ($$)
else { push @deps, \@dep_pkg_alts; }
}
}
- elsif ($key eq 'status') {
- unless ($value =~ /^\S+\s+\S+\s+(\S+)$/) {
- warn "Unrecognised Status line in $filename:\nStatus:
$value\n";
- }
- my $status = $1;
- # Hopefully, the system is in a nice state...
- # Ignore broken packages and removed but not purged packages
- next PACKAGE_ENTRY unless
- $status eq 'installed' or $status eq 'unpacked';
- }
}
$self->{$pkg} = \@deps;
+ undef $ctrl;
}
close PACKAGE_FILE or
croak("Problems encountered reading $filename: $!");
diff --git a/Devscripts/Packages.pm b/Devscripts/Packages.pm
index 66f547f..863ceb3 100644
--- a/Devscripts/Packages.pm
+++ b/Devscripts/Packages.pm
@@ -19,6 +19,7 @@
package Devscripts::Packages;
use Carp;
+use Dpkg::Control;
BEGIN{
use Exporter ();
@@ -183,12 +184,16 @@ sub FilesToPackages (@)
$curfile = shift;
}
elsif (/^(.*): \Q$curfile\E$/) {
- my @pkgs = split /, /, $1;
- if (@pkgs==1) { $packages{$pkgs[0]} = 1; }
+ my @pkgs = split /,\s+/, $1;
+ if (@pkgs == 1 || !grep /:/, @pkgs) {
+ # Only one package, or all Multi-Arch packages
+ map { $packages{$_} = 1 } @pkgs;
+ }
else {
# We've got a file which has been diverted by some package
- # and so is listed in two packages. The *diverting* package
- # is the one with the file that was actually used.
+ # or is Multi-Arch and so is listed in two packages. If it
+ # was diverted, the *diverting* package is the one with the
+ # file that was actually used.
my $found=0;
foreach my $pkg (@pkgs) {
if ($pkg eq $pkgfrom) {
@@ -216,21 +221,20 @@ sub FilesToPackages (@)
sub PackagesMatch ($)
{
- my $package;
my $match=$_[0];
my @matches=();
open STATUS, '/var/lib/dpkg/status'
or croak("Can't read /var/lib/dpkg/status: $!");
- while(<STATUS>) {
- chomp;
- s/\s+$//;
- if (/^Package: (.+)$/) { $package=$1; next; }
- /$match/ or next;
- push @matches, $package if $package;
- # So we only pick up each package at most once
- undef $package;
+ my $ctrl;
+ while (defined($ctrl = Dpkg::Control->new())
+ && $ctrl->parse(\*STATUS, '/var/lib/dpkg/status')) {
+ if ("$ctrl" =~ m/$match/m) {
+ my $package = $ctrl->{Package};
+ push @matches, $package;
+ }
+ undef $ctrl;
}
close STATUS or croak("Problem reading /var/lib/dpkg/status: $!");
@@ -239,24 +243,32 @@ sub PackagesMatch ($)
# Which packages are installed (Package and Source)?
-# This uses internal knowledge about the /var/lib/dpkg/status file
-# for efficiency - it runs 3 times faster than if it didn't use this
-# info.... And calling a shell script is faster still: thanks to
-# Arthur Korn <[email protected]> for this one ;-)
-# For the correct settings of -B# -A#, keep up-to-date with
-# the dpkg source, defn of fieldinfos[] in lib/parse.c
-# (and should match wnpp-alert.sh)
sub InstalledPackages ($)
{
- my $grep_pattern = $_[0] ? '^\(Package\|Source\):' : '^Package:';
+ my $source = $_[0];
- open (PKG, qq[grep -B2 -A7 'Status: install ok installed'
/var/lib/dpkg/status | grep '$grep_pattern' | cut -f2 -d' ' |])
- or croak("Problem opening grep pipe: $!");
+ open STATUS, '/var/lib/dpkg/status'
+ or croak("Can't read /var/lib/dpkg/status: $!");
- my %matches = map { chomp; $_ => 1 } <PKG>;
+ my $ctrl;
+ while (defined($ctrl = Dpkg::Control->new(type => CTRL_FILE_STATUS))
+ && $ctrl->parse(\*STATUS, '/var/lib/dpkg/status')) {
+ if ($ctrl->{Status} !~ /^install\s+ok\s+installed$/) {
+ next;
+ }
+ if ($source) {
+ if (exists $ctrl->{Source}) {
+ $matches{$ctrl->{Source}} = 1;
+ }
+ }
+ if (exists $ctrl->{Package}) {
+ $matches{$ctrl->{Package}} = 1;
+ }
+ undef $ctrl;
+ }
- close PKG or croak("Problem reading grep pipe: $!");
+ close STATUS or croak("Problem reading /var/lib/dpkg/status: $!");
return \%matches;
}
diff --git a/debian/changelog b/debian/changelog
index 456b283..6b1fa13 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -15,6 +15,8 @@ devscripts (2.11.10) UNRELEASED; urgency=low
with the stringified version of a file glob. (Closes: #678193)
* rc-alert: Unset wget's continue option to ensure the bug list is properly
downloaded. (Closes: #677229)
+ * Devscripts/Packages.pm, Devscripts/PackageDeps.pm: Parse dpkg's status
+ file using Dpkg::Control.
-- Benjamin Drung <[email protected]> Sun, 17 Jun 2012 23:33:41 +0200
--
Git repository for devscripts
_______________________________________________
devscripts-devel mailing list
[email protected]
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/devscripts-devel
