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

Annotation of /apt-installed-status/trunk/apt-installed-status

Parent Directory Parent Directory | Revision Log Revision Log


Revision 337 - (hide annotations)
Fri Jul 4 15:50:28 2014 UTC (5 years, 4 months ago) by frodo
File size: 13436 byte(s)
(Frodo) Add the -L option; bump version to 1.1

1 frodo 330 #!/usr/bin/perl -w
2    
3 frodo 333 # Copyright (c) 2014 by Frodo Looijaard <frodo@frodo.looijaard.name>
4     #
5     # License: GPL-3.0+
6     # This program is free software: you can redistribute it and/or modify
7     # it under the terms of the GNU General Public License as published by
8     # the Free Software Foundation, either version 3 of the License, or
9     # (at your option) any later version.
10     # .
11     # This package is distributed in the hope that it will be useful,
12     # but WITHOUT ANY WARRANTY; without even the implied warranty of
13     # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14     # GNU General Public License for more details.
15     # .
16     # You should have received a copy of the GNU General Public License
17     # along with this program. If not, see <http://www.gnu.org/licenses/>.
18     # .
19     # On Debian systems, the complete text of the GNU General
20     # Public License version 3 can be found in "/usr/share/common-licenses/GPL-3".
21    
22    
23 frodo 330 use strict;
24     use Getopt::Std;
25    
26     my $execname = 'apt-installed-status';
27 frodo 337 my $version = '1.1';
28 frodo 330
29    
30     ##########################
31     # HANDLE DATA COLLECTION #
32     ##########################
33    
34     # Global variables to hold data about all currently installed packages and
35     # all available packages in apt archives.
36    
37     # installed_packages: hash
38     # package name: reference to array
39     # counter: reference to hash
40     # 'package': string: package name (same as the primary hash key)
41     # 'binpackage': string: binary package name (may contain architecture)
42     # 'architecture': string: architecture
43     # 'version': string: version
44     # 'status': string: package status
45     my %installed_packages;
46    
47     # package_lists: hash
48     # list: reference to hash
49     # package name: reference to array
50     # counter: reference to hash
51     # 'package': string: package name (same as the primary hash key)
52     # 'architecture': string: architecture
53     # 'version': string: version
54     # 'multiarch': string: package multi-arch option (not always available)
55     my %package_lists;
56    
57 frodo 337 # When only the names of the package lists is asked for, we fill this variable.
58     # archives: array
59     # counter: string: name of the archive
60     my @archive_names;
61 frodo 330
62 frodo 337
63 frodo 330 # Read a package list file and save it into global variable %package_lists.
64     # Parameter 1: $file: File name (within /var/lib/apt/lists) of the package list
65     # Returns: Nothing
66     # Side effects: Fills in global variabale $package_lists{$file}
67     sub read_package_list
68     {
69     my ($file) = @_;
70     my ($entry,$package);
71     open(FILE, '/var/lib/apt/lists/'.$file) or die "Can't open $file: $!";
72     while (<FILE>) {
73     chomp;
74     ($package) = /^Package:\s*(.*)$/ if /^Package:/;
75     ($entry->{'architecture'}) = /^Architecture:\s*(.*)$/ if /^Architecture:/;
76     ($entry->{'version'}) = /^Version:\s*(.*)$/ if /^Version:/;
77     ($entry->{'multiarch'}) = /^Multi-Arch:\s*(.*)$/ if /^Multi-Arch:/;
78     if (/^\s*$/ and defined($package)) {
79     $entry->{'package'} = $package;
80     push (@{$package_lists{$file}->{$package}}, $entry);
81     undef($entry);
82     undef($package);
83     }
84     }
85     if (defined($entry)) {
86     push (@{$package_lists{$file}->{$package}}, $entry);
87     }
88     close(FILE);
89     }
90    
91     # Read all package list files and save them into global variable %package_lists.
92     # Parameters: None
93     # Returns: Nothing
94     # Side effects: Fills in global variabale $package_lists
95     sub read_all_package_lists
96     {
97     opendir(DIR, '/var/lib/apt/lists') or die "Can't opendir: $!";
98     while (defined(my $file = readdir(DIR))) {
99     read_package_list($file) if $file =~ /_Packages$/
100     }
101     closedir(DIR);
102     }
103    
104     # Read all installed packages and save them into global variable %installed_packages
105     # Parameters: None
106     # Returns: Nothing
107     # Side effects: Fills in global variabale $package_lists
108     sub read_installed_packages
109     {
110     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: $!";
111     while (<FILE>) {
112     chomp;
113     my ($status, $package, $binpackage,$version,$architecture) = split "\t";
114     push @{$installed_packages{$package}},{ 'status' => $status,
115     'binpackage' => $binpackage,
116     'version' => $version,
117     'package' => $package,
118     'architecture' => $architecture };
119     }
120     close FILE;
121     }
122    
123     # Try to locate a package in the archive lists, matching name, architecture
124     # and version.
125     # Parameters: $package_data: reference to a hash containing the package data
126     # Returns: An array of lists in which this package is available
127     sub find_package
128     {
129     my ($package_data) = @_;
130     my @lists_found = ();
131     foreach my $listname (keys %package_lists) {
132     if (exists ($package_lists{$listname}->{$package_data->{'package'}})) {
133     foreach my $entry (@{$package_lists{$listname}->{$package_data->{'package'}}}) {
134     if ($entry->{'architecture'} eq $package_data->{'architecture'} and $entry->{'version'} eq $package_data->{'version'}) {
135     push @lists_found,$listname;
136     last;
137     }
138     }
139     }
140     }
141     return \@lists_found;
142     }
143    
144     # Determine for all installed packages in which archives they are found
145     # Parameters: None
146     # Returns: Nothing
147     # Side effects: Fills in global variabale $installed_packages
148     sub find_all_packages
149     {
150     foreach my $package_name (keys %installed_packages) {
151     foreach my $entry (@{$installed_packages{$package_name}}) {
152     $entry->{'lists'} = find_package($entry);
153     }
154     }
155     }
156    
157     # Fill all global variables
158     sub init
159     {
160     read_installed_packages();
161     read_all_package_lists();
162     find_all_packages();
163     }
164    
165 frodo 337 # Determine which package archives are available.
166     # Parameters: None
167     # Returns: Nothing
168     # Side effects: Fills in global variabale @archive_names
169     sub init_names
170     {
171     opendir(DIR, '/var/lib/apt/lists') or die "Can't opendir: $!";
172     while (defined(my $file = readdir(DIR))) {
173     push (@archive_names,$file) if $file =~ /_Packages$/
174     }
175     closedir(DIR);
176     }
177 frodo 330
178 frodo 337
179 frodo 330 ###############
180     # OUTPUT DATA #
181     ###############
182    
183 frodo 337 sub print_archive_names
184     {
185     print join("\n", sort @archive_names)."\n";
186     }
187    
188     sub print_archive_names_only
189     {
190     my ($archives) = @_;
191     my %archives;
192     foreach my $archive (split (/,/,$archives)) {
193     $archives{$archive} = 1;
194     }
195     print join("\n", sort (grep { exists $archives{$_} } @archive_names))."\n";
196     }
197    
198     sub print_archive_names_only_regexp
199     {
200     my ($archives_regexp) = @_;
201     print join("\n", sort (grep /$archives_regexp/,@archive_names))."\n";
202     }
203    
204     sub print_archive_names_except
205     {
206     my ($archives) = @_;
207     my %archives;
208     foreach my $archive (split (/,/,$archives)) {
209     $archives{$archive} = 1;
210     }
211     print join("\n", sort (grep { ! exists $archives{$_} } @archive_names))."\n";
212     }
213    
214     sub print_archive_names_except_regexp
215     {
216     my ($archives_regexp) = @_;
217     print join("\n", sort (grep !/$archives_regexp/,@archive_names))."\n";
218     }
219    
220 frodo 332 # Go through the list of all packages and call a subroutine on each installed
221     # package.
222     # Parameter 1: $sub: Reference to the subroutine to call
223     # Each call gets two parameters: the entry and $long
224     # Parameter 2..: @params: All other parameters
225     # Returns: Nothing
226     # Side effects: Generates output on STDOUT
227     sub iterate_through_packages {
228     my ($sub, @params) = @_;
229     foreach my $package_name (sort keys %installed_packages) {
230     foreach my $entry (@{$installed_packages{$package_name}}) {
231 frodo 330 if ($entry->{status} eq 'install ok installed') {
232 frodo 332 &$sub($entry, @params)
233 frodo 330 }
234     }
235     }
236     }
237    
238 frodo 332 # Print an entry, either with or without its archives
239     # Parameter 1: $entry: a hash reference containing keys package, architecture
240     # and version (as well as lists if $long is true)
241     # Parameter 2: $long: whether to print the archives too
242     # Returns: nothing
243     # Side effects: Generates output on STDOUT
244     sub print_item
245 frodo 330 {
246 frodo 332 my ($entry, $long) = @_;
247     if ($long) {
248     print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n";
249     } else {
250     print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n";
251 frodo 330 }
252     }
253    
254 frodo 332 # Print all packages, including archives
255     sub print_all
256     {
257     iterate_through_packages(\&print_item, 1);
258     }
259    
260    
261     # Print only those packages that have no archive associated with them
262     sub print_orphans
263     {
264     iterate_through_packages(\&print_orphans_item);
265     }
266    
267     # Callback: check whether an entry is an orphan and if so print it
268     sub print_orphans_item
269     {
270     my ($entry) = @_;
271     if (! @{$entry->{lists}}) {
272     print_item($entry, 0);
273     }
274     }
275    
276     # Print those packages which are only in the specified archives
277 frodo 330 sub print_archives_only
278     {
279     my ($archives,$long) = @_;
280     my %archives;
281     foreach my $archive (split (/,/,$archives)) {
282     $archives{$archive} = 1;
283     }
284 frodo 332 iterate_through_packages(\&print_archives_only_item, \%archives, $long);
285     }
286    
287     # Callback: print an entry if it is only in the specified archives
288     sub print_archives_only_item
289     {
290     my ($entry,$archives, $long) = @_;
291     my $valid = 1;
292     foreach my $list (@{$entry->{lists}}) {
293     if (! exists($archives->{$list})) {
294     $valid = 0;
295     last;
296 frodo 330 }
297     }
298 frodo 332 if ($valid and @{$entry->{lists}}) {
299     print_item($entry, $long)
300     }
301 frodo 330 }
302    
303 frodo 332 # Print those packages which are only in the archives specified through a
304     # regular expression
305 frodo 330 sub print_archives_only_regexp
306     {
307     my ($archives_regexp,$long) = @_;
308 frodo 332 iterate_through_packages(\&print_archives_only_regexp_item, $archives_regexp, $long);
309     }
310    
311     # Callback: print an entry if it is only in the archives specified through a
312     # regular expression
313     sub print_archives_only_regexp_item
314     {
315     my ($entry, $archives_regexp, $long) = @_;
316     my $valid = 1;
317     foreach my $list (@{$entry->{lists}}) {
318     if (! ($list =~ /$archives_regexp/)) {
319     $valid = 0;
320     last;
321 frodo 330 }
322     }
323 frodo 332 if ($valid and @{$entry->{lists}}) {
324     print_item($entry, $long)
325     }
326 frodo 330 }
327    
328 frodo 332 # Print those packages which are not in the specified archives
329     sub print_archives_except
330     {
331     my ($archives,$long) = @_;
332     my %archives;
333     foreach my $archive (split (/,/,$archives)) {
334     $archives{$archive} = 1;
335     }
336     iterate_through_packages(\&print_archives_except_item, \%archives, $long);
337     }
338 frodo 330
339 frodo 332 # Callback: print an entry if it is not in the specified archives
340     sub print_archives_except_item
341     {
342     my ($entry,$archives, $long) = @_;
343     my $valid = 1;
344     foreach my $list (@{$entry->{lists}}) {
345     if (exists($archives->{$list})) {
346     $valid = 0;
347     last;
348     }
349     }
350     if ($valid and @{$entry->{lists}}) {
351     print_item($entry, $long)
352     }
353     }
354    
355     # Print those packages which are not in the archives specified through a
356     # regular expression
357     sub print_archives_except_regexp
358     {
359     my ($archives_regexp,$long) = @_;
360     iterate_through_packages(\&print_archives_except_regexp_item, $archives_regexp, $long);
361     }
362    
363     # Callback: print an entry if it is not in the archives specified through a
364     # regular expression
365     sub print_archives_except_regexp_item
366     {
367     my ($entry, $archives_regexp, $long) = @_;
368     my $valid = 1;
369     foreach my $list (@{$entry->{lists}}) {
370     if ($list =~ /$archives_regexp/) {
371     $valid = 0;
372     last;
373     }
374     }
375     if ($valid and @{$entry->{lists}}) {
376     print_item($entry, $long)
377     }
378     }
379    
380 frodo 330 #########################
381     # COMMAND LINE HANDLING #
382     #########################
383    
384     sub print_help
385     {
386     print STDERR "$execname [OPTION]\n";
387     print STDERR " -h: help text and exit\n";
388     print STDERR " -V: print version and exit\n";
389     print STDERR " -o: orphans: packages that are not in any archive\n";
390     print STDERR " -a ARCHS: archives: list all packages that are only in one of the listed\n";
391     print STDERR " archives (seperated by commas)\n";
392     print STDERR " -A ARCHREGEXP: archives: list all packages that are only in archives\n";
393     print STDERR " that match the regular expression\n";
394 frodo 332 print STDERR " -x ARCHS: except: list all packages that are not in one of the listed\n";
395     print STDERR " archives (seperated by commas)\n";
396     print STDERR " -X ARCHREGEXP: except: list all packages that are not in archives\n";
397     print STDERR " that match the regular expression\n";
398 frodo 330 print STDERR " -l: long: print archives too\n";
399 frodo 337 print STDERR " -L: list: print archives that are selected instead of packages\n";
400 frodo 330
401     print STDERR "Default: print all packages and sources\n";
402     }
403    
404     sub print_version
405     {
406     print STDERR "$execname $version\n";
407     }
408    
409     sub HELP_MESSAGE
410     {
411     print_help();
412     exit 0;
413     }
414    
415     $Getopt::Std::STANDARD_HELP_VERSION=1;
416    
417     our $VERSION=$version;
418     my %options;
419 frodo 337 if (! getopts('hVoLla:A:x:X:',\%options))
420 frodo 330 {
421     print_help();
422     exit 1;
423     }
424     my $long=0;
425 frodo 337 my $names_only=0;
426    
427 frodo 330 if ($options{'h'}) {
428     print_help();
429     exit 0;
430     }
431     if ($options{'V'}) {
432     print_version();
433     exit 0;
434     }
435 frodo 337 if ($options{'L'}) {
436     $names_only=1;
437     }
438     if ($names_only) {
439     init_names();
440     } else {
441     init();
442     }
443 frodo 330 if ($options{'o'}) {
444     print_orphans();
445     exit 0;
446     }
447     if ($options{l}) {
448     $long = 1;
449     }
450     if ($options{a}) {
451 frodo 337 if ($names_only) {
452     print_archive_names_only($options{a});
453     } else {
454     print_archives_only($options{a},$long);
455     }
456 frodo 330 exit 0;
457     }
458     if ($options{A}) {
459 frodo 337 if ($names_only) {
460     print_archive_names_only_regexp($options{A});
461     } else {
462     print_archives_only_regexp($options{A},$long);
463     }
464 frodo 330 exit 0;
465     }
466 frodo 332 if ($options{x}) {
467 frodo 337 if ($names_only) {
468     print_archive_names_except($options{x});
469     } else {
470     print_archives_except($options{x},$long);
471     }
472 frodo 332 exit 0;
473     }
474     if ($options{X}) {
475 frodo 337 if ($names_only) {
476     print_archive_names_except($options{X});
477     } else {
478     print_archives_except_regexp($options{X},$long);
479     }
480 frodo 332 exit 0;
481     }
482 frodo 337 if ($names_only) {
483     print_archive_names()
484     } else {
485     print_all();
486     }
487 frodo 330
488    
489     # vim:sw=2:ft=perl:expandtab:

Properties

Name Value
svn:executable *

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