/[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 332 - (hide annotations)
Thu Jun 12 09:52:01 2014 UTC (9 years, 9 months ago) by frodo
File size: 10653 byte(s)
(Frodo) Add -X/-x option (except) and restructure to use callbacks

1 frodo 330 #!/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 frodo 332 # Go through the list of all packages and call a subroutine on each installed
148     # package.
149     # Parameter 1: $sub: Reference to the subroutine to call
150     # Each call gets two parameters: the entry and $long
151     # Parameter 2..: @params: All other parameters
152     # Returns: Nothing
153     # Side effects: Generates output on STDOUT
154     sub iterate_through_packages {
155     my ($sub, @params) = @_;
156     foreach my $package_name (sort keys %installed_packages) {
157     foreach my $entry (@{$installed_packages{$package_name}}) {
158 frodo 330 if ($entry->{status} eq 'install ok installed') {
159 frodo 332 &$sub($entry, @params)
160 frodo 330 }
161     }
162     }
163     }
164    
165 frodo 332 # Print an entry, either with or without its archives
166     # Parameter 1: $entry: a hash reference containing keys package, architecture
167     # and version (as well as lists if $long is true)
168     # Parameter 2: $long: whether to print the archives too
169     # Returns: nothing
170     # Side effects: Generates output on STDOUT
171     sub print_item
172 frodo 330 {
173 frodo 332 my ($entry, $long) = @_;
174     if ($long) {
175     print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n";
176     } else {
177     print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n";
178 frodo 330 }
179     }
180    
181 frodo 332 # Print all packages, including archives
182     sub print_all
183     {
184     iterate_through_packages(\&print_item, 1);
185     }
186    
187    
188     # Print only those packages that have no archive associated with them
189     sub print_orphans
190     {
191     iterate_through_packages(\&print_orphans_item);
192     }
193    
194     # Callback: check whether an entry is an orphan and if so print it
195     sub print_orphans_item
196     {
197     my ($entry) = @_;
198     if (! @{$entry->{lists}}) {
199     print_item($entry, 0);
200     }
201     }
202    
203     # Print those packages which are only in the specified archives
204 frodo 330 sub print_archives_only
205     {
206     my ($archives,$long) = @_;
207     my %archives;
208     foreach my $archive (split (/,/,$archives)) {
209     $archives{$archive} = 1;
210     }
211 frodo 332 iterate_through_packages(\&print_archives_only_item, \%archives, $long);
212     }
213    
214     # Callback: print an entry if it is only in the specified archives
215     sub print_archives_only_item
216     {
217     my ($entry,$archives, $long) = @_;
218     my $valid = 1;
219     foreach my $list (@{$entry->{lists}}) {
220     if (! exists($archives->{$list})) {
221     $valid = 0;
222     last;
223 frodo 330 }
224     }
225 frodo 332 if ($valid and @{$entry->{lists}}) {
226     print_item($entry, $long)
227     }
228 frodo 330 }
229    
230 frodo 332 # Print those packages which are only in the archives specified through a
231     # regular expression
232 frodo 330 sub print_archives_only_regexp
233     {
234     my ($archives_regexp,$long) = @_;
235 frodo 332 iterate_through_packages(\&print_archives_only_regexp_item, $archives_regexp, $long);
236     }
237    
238     # Callback: print an entry if it is only in the archives specified through a
239     # regular expression
240     sub print_archives_only_regexp_item
241     {
242     my ($entry, $archives_regexp, $long) = @_;
243     my $valid = 1;
244     foreach my $list (@{$entry->{lists}}) {
245     if (! ($list =~ /$archives_regexp/)) {
246     $valid = 0;
247     last;
248 frodo 330 }
249     }
250 frodo 332 if ($valid and @{$entry->{lists}}) {
251     print_item($entry, $long)
252     }
253 frodo 330 }
254    
255 frodo 332 # Print those packages which are not in the specified archives
256     sub print_archives_except
257     {
258     my ($archives,$long) = @_;
259     my %archives;
260     foreach my $archive (split (/,/,$archives)) {
261     $archives{$archive} = 1;
262     }
263     iterate_through_packages(\&print_archives_except_item, \%archives, $long);
264     }
265 frodo 330
266 frodo 332 # Callback: print an entry if it is not in the specified archives
267     sub print_archives_except_item
268     {
269     my ($entry,$archives, $long) = @_;
270     my $valid = 1;
271     foreach my $list (@{$entry->{lists}}) {
272     if (exists($archives->{$list})) {
273     $valid = 0;
274     last;
275     }
276     }
277     if ($valid and @{$entry->{lists}}) {
278     print_item($entry, $long)
279     }
280     }
281    
282     # Print those packages which are not in the archives specified through a
283     # regular expression
284     sub print_archives_except_regexp
285     {
286     my ($archives_regexp,$long) = @_;
287     iterate_through_packages(\&print_archives_except_regexp_item, $archives_regexp, $long);
288     }
289    
290     # Callback: print an entry if it is not in the archives specified through a
291     # regular expression
292     sub print_archives_except_regexp_item
293     {
294     my ($entry, $archives_regexp, $long) = @_;
295     my $valid = 1;
296     foreach my $list (@{$entry->{lists}}) {
297     if ($list =~ /$archives_regexp/) {
298     $valid = 0;
299     last;
300     }
301     }
302     if ($valid and @{$entry->{lists}}) {
303     print_item($entry, $long)
304     }
305     }
306    
307 frodo 330 #########################
308     # COMMAND LINE HANDLING #
309     #########################
310    
311     sub print_help
312     {
313     print STDERR "$execname [OPTION]\n";
314     print STDERR " -h: help text and exit\n";
315     print STDERR " -V: print version and exit\n";
316     print STDERR " -o: orphans: packages that are not in any archive\n";
317     print STDERR " -a ARCHS: archives: list all packages that are only in one of the listed\n";
318     print STDERR " archives (seperated by commas)\n";
319     print STDERR " -A ARCHREGEXP: archives: list all packages that are only in archives\n";
320     print STDERR " that match the regular expression\n";
321 frodo 332 print STDERR " -x ARCHS: except: list all packages that are not in one of the listed\n";
322     print STDERR " archives (seperated by commas)\n";
323     print STDERR " -X ARCHREGEXP: except: list all packages that are not in archives\n";
324     print STDERR " that match the regular expression\n";
325 frodo 330 print STDERR " -l: long: print archives too\n";
326    
327     print STDERR "Default: print all packages and sources\n";
328     }
329    
330     sub print_version
331     {
332     print STDERR "$execname $version\n";
333     }
334    
335     sub HELP_MESSAGE
336     {
337     print_help();
338     exit 0;
339     }
340    
341     $Getopt::Std::STANDARD_HELP_VERSION=1;
342    
343     our $VERSION=$version;
344     my %options;
345 frodo 332 if (! getopts('hVola:A:x:X:',\%options))
346 frodo 330 {
347     print_help();
348     exit 1;
349     }
350     my $long=0;
351     if ($options{'h'}) {
352     print_help();
353     exit 0;
354     }
355     if ($options{'V'}) {
356     print_version();
357     exit 0;
358     }
359     init();
360     if ($options{'o'}) {
361     print_orphans();
362     exit 0;
363     }
364     if ($options{l}) {
365     $long = 1;
366     }
367     if ($options{a}) {
368     print_archives_only($options{a},$long);
369     exit 0;
370     }
371     if ($options{A}) {
372     print_archives_only_regexp($options{A},$long);
373     exit 0;
374     }
375 frodo 332 if ($options{x}) {
376     print_archives_except($options{x},$long);
377     exit 0;
378     }
379     if ($options{X}) {
380     print_archives_except_regexp($options{X},$long);
381     exit 0;
382     }
383 frodo 330 print_all;
384    
385    
386     # vim:sw=2:ft=perl:expandtab:

Properties

Name Value
svn:executable *

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