/[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 330 - (hide annotations)
Thu Jun 12 08:41:58 2014 UTC (9 years, 9 months ago) by frodo
File size: 8338 byte(s)
Imported sources

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     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