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 <ande...@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 <ande...@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 _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits