[debsums] 127/184: Use dpkg-query instead of reading /var/lib/dpkg/status
Axel Beckert
abe at deuxchevaux.org
Mon Mar 2 21:21:25 UTC 2015
This is an automated email from the git hooks/post-receive script.
abe pushed a commit to branch master
in repository debsums.
commit 8b0e2cf537a11df7783a2be49fc380fe2abb7ce3
Author: Anders Kaseorg <andersk at mit.edu>
Date: Thu Jul 7 21:04:03 2011 -0400
Use dpkg-query instead of reading /var/lib/dpkg/status
Signed-off-by: Anders Kaseorg <andersk at mit.edu>
---
debsums | 41 ++++++++++++++++++++++++++++-------------
1 file changed, 28 insertions(+), 13 deletions(-)
diff --git a/debsums b/debsums
index d64a5e7..278f19a 100755
--- a/debsums
+++ b/debsums
@@ -116,6 +116,29 @@ sub warn_or_die {
}
}
+sub parse_dpkg {
+ my ($command_cb, $field_names) = @_;
+
+ local $/ = "\n\n"; # Separator that cannot appear in dpkg status format
+ my @command = &$command_cb('--showformat=' .
+ (join '', map {"\${$_}$/"} @$field_names));
+ open DPKG, '-|', @command
+ or die "$self: can't run dpkg-query ($!)\n";
+
+ my @ret;
+ while (!eof DPKG)
+ {
+ my %field = map {$_, scalar <DPKG>} @$field_names;
+ chomp @field{@$field_names};
+ push @ret, \%field;
+ }
+
+ close DPKG or die "$self: @command failed (",
+ $! ? $! : $? >> 8 ? "exit status " . ($? >> 8) : "signal " . ($? & 127),
+ ")\n";
+ return @ret;
+}
+
$root ||= '';
$admindir ||= '/var/lib/dpkg';
my $DPKG = $root . $admindir;
@@ -181,16 +204,11 @@ if ($gen_opt)
my %installed;
my %replaced;
{
- open STATUS, "$DPKG/status" or die "$self: can't open $DPKG/status ($!)\n";
- local $/ = '';
-
- while (<STATUS>)
- {
- chomp;
- my %field = map /^(\S+):\s+(.*)/ms, split /\n(?!\s)/;
- next unless exists $field{Package}
- and exists $field{Version}
- and exists $field{Status}
+ for my $fields (parse_dpkg(sub {'dpkg-query', "--admindir=$DPKG", @_, '--show'},
+ [qw(Package Version Status Conffiles Replaces)])) {
+ my %field = %$fields;
+ next unless $field{Package} ne ''
+ and $field{Version} ne ''
and $field{Status} =~ /\sinstalled$/;
$installed{$field{Package}}{Version} = $field{Version};
@@ -198,7 +216,6 @@ my %replaced;
map m!^\s*/(\S+)\s+([\da-f]+)!, split /\n/, $field{Conffiles}
} if $field{Conffiles};
- next unless exists $field{Replaces};
for (split /,\s*/, $field{Replaces})
{
my ($pack, $ver) = /^(\S+)(?:\s+\(([^)]+)\))?$/;
@@ -211,8 +228,6 @@ my %replaced;
push @{$replaced{$pack}{$ver || 'all'}}, $field{Package};
}
}
-
- close STATUS;
}
my %diversion;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/debsums.git
More information about the Pkg-perl-cvs-commits
mailing list