chiark / gitweb /
get-kernel: Only move 'linux' out of the way if it exists as a symbolic
[bin.git] / verify-status
1 #! /usr/bin/perl -w
2 use strict;
3
4 my $verbose = 0;
5
6 while (@ARGV) {
7         my $arg = shift;
8         if ($arg eq '-v' or $arg eq '--verbose') {
9                 $verbose = 1;
10         } else {
11                 warn "Unrecognized option: $arg\n";
12         }
13 }
14
15 local (*AVAILABLE, *STATUS);
16 open AVAILABLE, '</var/lib/dpkg/available' or
17         die "Can't open available file: $!";
18 open STATUS, '</var/lib/dpkg/status' or die "Can't open status file: $!";
19
20 my (%available, %status);
21 my $package;
22
23 while (<AVAILABLE>)
24 {
25         if (/^Package: (.*)/)
26         {
27                 $package = $1;
28         }
29         elsif (/^Version: (.*)/)
30         {
31                 $available{$package} = $1;
32                 undef $package;
33         }
34 }
35
36 while (<STATUS>)
37 {
38         if (/^Package: (.*)/)
39         {
40                 $package = $1;
41         }
42         elsif (/^Version: (.*)/)
43         {
44                 $status{$package} = $1;
45                 undef $package;
46         }
47 }
48
49 close STATUS;
50 close AVAILABLE;
51
52 foreach my $package (sort keys %available)
53 {
54         my ($av, $st) = ($available{$package}, $status{$package});
55         if (defined $st)
56         {
57                 if ($av ne $st) {
58                         print "!!! $package $av $st\n";
59                 } elsif ($verbose) {
60                         print "$package $av $st\n";
61                 }
62         }
63 }
64