/[public]/apt-installed-status/trunk/apt-installed-status
ViewVC logotype

Contents of /apt-installed-status/trunk/apt-installed-status

Parent Directory Parent Directory | Revision Log Revision Log


Revision 330 - (show annotations)
Thu Jun 12 08:41:58 2014 UTC (10 years, 3 months ago) by frodo
File size: 8338 byte(s)
Imported sources

1 #!/usr/bin/perl -w
2
3 use strict;
4 use Getopt::Std;
5
6 use Data::Dumper;
7
8 my $execname = 'apt-installed-status';
9 my $version = '1.0';
10
11
12 ##########################
13 # HANDLE DATA COLLECTION #
14 ##########################
15
16 # Global variables to hold data about all currently installed packages and
17 # all available packages in apt archives.
18
19 # installed_packages: hash
20 # package name: reference to array
21 # counter: reference to hash
22 # 'package': string: package name (same as the primary hash key)
23 # 'binpackage': string: binary package name (may contain architecture)
24 # 'architecture': string: architecture
25 # 'version': string: version
26 # 'status': string: package status
27 my %installed_packages;
28
29 # package_lists: hash
30 # list: reference to hash
31 # package name: reference to array
32 # counter: reference to hash
33 # 'package': string: package name (same as the primary hash key)
34 # 'architecture': string: architecture
35 # 'version': string: version
36 # 'multiarch': string: package multi-arch option (not always available)
37 my %package_lists;
38
39
40 # Read a package list file and save it into global variable %package_lists.
41 # Parameter 1: $file: File name (within /var/lib/apt/lists) of the package list
42 # Returns: Nothing
43 # Side effects: Fills in global variabale $package_lists{$file}
44 sub read_package_list
45 {
46 my ($file) = @_;
47 my ($entry,$package);
48 open(FILE, '/var/lib/apt/lists/'.$file) or die "Can't open $file: $!";
49 while (<FILE>) {
50 chomp;
51 ($package) = /^Package:\s*(.*)$/ if /^Package:/;
52 ($entry->{'architecture'}) = /^Architecture:\s*(.*)$/ if /^Architecture:/;
53 ($entry->{'version'}) = /^Version:\s*(.*)$/ if /^Version:/;
54 ($entry->{'multiarch'}) = /^Multi-Arch:\s*(.*)$/ if /^Multi-Arch:/;
55 if (/^\s*$/ and defined($package)) {
56 $entry->{'package'} = $package;
57 push (@{$package_lists{$file}->{$package}}, $entry);
58 undef($entry);
59 undef($package);
60 }
61 }
62 if (defined($entry)) {
63 push (@{$package_lists{$file}->{$package}}, $entry);
64 }
65 close(FILE);
66 }
67
68 # Read all package list files and save them into global variable %package_lists.
69 # Parameters: None
70 # Returns: Nothing
71 # Side effects: Fills in global variabale $package_lists
72 sub read_all_package_lists
73 {
74 opendir(DIR, '/var/lib/apt/lists') or die "Can't opendir: $!";
75 while (defined(my $file = readdir(DIR))) {
76 read_package_list($file) if $file =~ /_Packages$/
77 }
78 closedir(DIR);
79 }
80
81 # Read all installed packages and save them into global variable %installed_packages
82 # Parameters: None
83 # Returns: Nothing
84 # Side effects: Fills in global variabale $package_lists
85 sub read_installed_packages
86 {
87 open(FILE,"dpkg-query -W -f'\${status}\t\${package}\t\${binary:package}\t\${version}\t\${architecture}\n'|") or die "Can't open pipe to dpkq-query: $!";
88 while (<FILE>) {
89 chomp;
90 my ($status, $package, $binpackage,$version,$architecture) = split "\t";
91 push @{$installed_packages{$package}},{ 'status' => $status,
92 'binpackage' => $binpackage,
93 'version' => $version,
94 'package' => $package,
95 'architecture' => $architecture };
96 }
97 close FILE;
98 }
99
100 # Try to locate a package in the archive lists, matching name, architecture
101 # and version.
102 # Parameters: $package_data: reference to a hash containing the package data
103 # Returns: An array of lists in which this package is available
104 sub find_package
105 {
106 my ($package_data) = @_;
107 my @lists_found = ();
108 foreach my $listname (keys %package_lists) {
109 if (exists ($package_lists{$listname}->{$package_data->{'package'}})) {
110 foreach my $entry (@{$package_lists{$listname}->{$package_data->{'package'}}}) {
111 if ($entry->{'architecture'} eq $package_data->{'architecture'} and $entry->{'version'} eq $package_data->{'version'}) {
112 push @lists_found,$listname;
113 last;
114 }
115 }
116 }
117 }
118 return \@lists_found;
119 }
120
121 # Determine for all installed packages in which archives they are found
122 # Parameters: None
123 # Returns: Nothing
124 # Side effects: Fills in global variabale $installed_packages
125 sub find_all_packages
126 {
127 foreach my $package_name (keys %installed_packages) {
128 foreach my $entry (@{$installed_packages{$package_name}}) {
129 $entry->{'lists'} = find_package($entry);
130 }
131 }
132 }
133
134 # Fill all global variables
135 sub init
136 {
137 read_installed_packages();
138 read_all_package_lists();
139 find_all_packages();
140 }
141
142
143 ###############
144 # OUTPUT DATA #
145 ###############
146
147 sub print_orphans
148 {
149 foreach my $package_data (values %installed_packages) {
150 foreach my $entry (@$package_data) {
151 if ($entry->{status} eq 'install ok installed') {
152 if (! @{$entry->{lists}}) {
153 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n";
154 }
155 }
156 }
157 }
158 }
159
160 sub print_all
161 {
162 foreach my $package_name (sort keys %installed_packages) {
163 foreach my $entry (@{$installed_packages{$package_name}}) {
164 if ($entry->{status} eq 'install ok installed') {
165 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n";
166 }
167 }
168 }
169 }
170
171 sub print_archives_only
172 {
173 my ($archives,$long) = @_;
174 my %archives;
175 foreach my $archive (split (/,/,$archives)) {
176 $archives{$archive} = 1;
177 }
178 foreach my $package_name (sort keys %installed_packages) {
179 foreach my $entry (@{$installed_packages{$package_name}}) {
180 if ($entry->{status} eq 'install ok installed') {
181 my $valid = 1;
182 my $nr=0;
183 foreach my $list (@{$entry->{lists}}) {
184 $nr++;
185 if (! exists($archives{$list})) {
186 $valid = 0;
187 last;
188 }
189 }
190 if ($valid and $nr) {
191 if ($long) {
192 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n";
193 } else {
194 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n";
195 }
196 }
197 }
198 }
199 }
200 }
201
202 sub print_archives_only_regexp
203 {
204 my ($archives_regexp,$long) = @_;
205 foreach my $package_name (sort keys %installed_packages) {
206 foreach my $entry (@{$installed_packages{$package_name}}) {
207 if ($entry->{status} eq 'install ok installed') {
208 my $valid = 1;
209 my $nr=0;
210 foreach my $list (@{$entry->{lists}}) {
211 $nr++;
212 if (! ($list =~ /$archives_regexp/)) {
213 $valid = 0;
214 last;
215 }
216 }
217 if ($valid and $nr) {
218 if ($long) {
219 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n";
220 } else {
221 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n";
222 }
223 }
224 }
225 }
226 }
227 }
228
229
230 #########################
231 # COMMAND LINE HANDLING #
232 #########################
233
234 sub print_help
235 {
236 print STDERR "$execname [OPTION]\n";
237 print STDERR " -h: help text and exit\n";
238 print STDERR " -V: print version and exit\n";
239 print STDERR " -o: orphans: packages that are not in any archive\n";
240 print STDERR " -a ARCHS: archives: list all packages that are only in one of the listed\n";
241 print STDERR " archives (seperated by commas)\n";
242 print STDERR " -A ARCHREGEXP: archives: list all packages that are only in archives\n";
243 print STDERR " that match the regular expression\n";
244 print STDERR " -l: long: print archives too\n";
245
246 print STDERR "Default: print all packages and sources\n";
247 }
248
249 sub print_version
250 {
251 print STDERR "$execname $version\n";
252 }
253
254 sub HELP_MESSAGE
255 {
256 print_help();
257 exit 0;
258 }
259
260 $Getopt::Std::STANDARD_HELP_VERSION=1;
261
262 our $VERSION=$version;
263 my %options;
264 if (! getopts('hVola:A:',\%options))
265 {
266 print_help();
267 exit 1;
268 }
269 my $long=0;
270 if ($options{'h'}) {
271 print_help();
272 exit 0;
273 }
274 if ($options{'V'}) {
275 print_version();
276 exit 0;
277 }
278 init();
279 if ($options{'o'}) {
280 print_orphans();
281 exit 0;
282 }
283 if ($options{l}) {
284 $long = 1;
285 }
286 if ($options{a}) {
287 print_archives_only($options{a},$long);
288 exit 0;
289 }
290 if ($options{A}) {
291 print_archives_only_regexp($options{A},$long);
292 exit 0;
293 }
294 print_all;
295
296
297 # vim:sw=2:ft=perl:expandtab:

Properties

Name Value
svn:executable *

frodo@frodo.looijaard.name
ViewVC Help
Powered by ViewVC 1.1.26