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

Diff of /apt-installed-status/trunk/apt-installed-status

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 330 Revision 333
1#!/usr/bin/perl -w 1#!/usr/bin/perl -w
2
3# 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
2 22
3use strict; 23use strict;
4use Getopt::Std; 24use Getopt::Std;
5
6use Data::Dumper;
7 25
8my $execname = 'apt-installed-status'; 26my $execname = 'apt-installed-status';
9my $version = '1.0'; 27my $version = '1.0';
10 28
11 29
… …
142 160
143############### 161###############
144# OUTPUT DATA # 162# OUTPUT DATA #
145############### 163###############
146 164
147sub print_orphans 165# Go through the list of all packages and call a subroutine on each installed
148{ 166# package.
149 foreach my $package_data (values %installed_packages) { 167# Parameter 1: $sub: Reference to the subroutine to call
150 foreach my $entry (@$package_data) { 168# Each call gets two parameters: the entry and $long
151 if ($entry->{status} eq 'install ok installed') { 169# Parameter 2..: @params: All other parameters
152 if (! @{$entry->{lists}}) { 170# Returns: Nothing
153 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n"; 171# Side effects: Generates output on STDOUT
154 } 172sub iterate_through_packages {
155 } 173 my ($sub, @params) = @_;
156 }
157 }
158}
159
160sub print_all
161{
162 foreach my $package_name (sort keys %installed_packages) { 174 foreach my $package_name (sort keys %installed_packages) {
163 foreach my $entry (@{$installed_packages{$package_name}}) { 175 foreach my $entry (@{$installed_packages{$package_name}}) {
164 if ($entry->{status} eq 'install ok installed') { 176 if ($entry->{status} eq 'install ok installed') {
165 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n"; 177 &$sub($entry, @params)
166 } 178 }
167 } 179 }
168 } 180 }
169} 181}
170 182
183# Print an entry, either with or without its archives
184# Parameter 1: $entry: a hash reference containing keys package, architecture
185# and version (as well as lists if $long is true)
186# Parameter 2: $long: whether to print the archives too
187# Returns: nothing
188# Side effects: Generates output on STDOUT
189sub print_item
190{
191 my ($entry, $long) = @_;
192 if ($long) {
193 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n";
194 } else {
195 print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n";
196 }
197}
198
199# Print all packages, including archives
200sub print_all
201{
202 iterate_through_packages(\&print_item, 1);
203}
204
205
206# Print only those packages that have no archive associated with them
207sub print_orphans
208{
209 iterate_through_packages(\&print_orphans_item);
210}
211
212# Callback: check whether an entry is an orphan and if so print it
213sub print_orphans_item
214{
215 my ($entry) = @_;
216 if (! @{$entry->{lists}}) {
217 print_item($entry, 0);
218 }
219}
220
221# Print those packages which are only in the specified archives
171sub print_archives_only 222sub print_archives_only
172{ 223{
173 my ($archives,$long) = @_; 224 my ($archives,$long) = @_;
174 my %archives; 225 my %archives;
175 foreach my $archive (split (/,/,$archives)) { 226 foreach my $archive (split (/,/,$archives)) {
176 $archives{$archive} = 1; 227 $archives{$archive} = 1;
177 } 228 }
178 foreach my $package_name (sort keys %installed_packages) { 229 iterate_through_packages(\&print_archives_only_item, \%archives, $long);
179 foreach my $entry (@{$installed_packages{$package_name}}) { 230}
180 if ($entry->{status} eq 'install ok installed') { 231
232# Callback: print an entry if it is only in the specified archives
233sub print_archives_only_item
234{
235 my ($entry,$archives, $long) = @_;
181 my $valid = 1; 236 my $valid = 1;
182 my $nr=0;
183 foreach my $list (@{$entry->{lists}}) { 237 foreach my $list (@{$entry->{lists}}) {
184 $nr++;
185 if (! exists($archives{$list})) { 238 if (! exists($archives->{$list})) {
186 $valid = 0; 239 $valid = 0;
187 last; 240 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 } 241 }
198 } 242 }
243 if ($valid and @{$entry->{lists}}) {
244 print_item($entry, $long)
199 } 245 }
200} 246}
201 247
248# Print those packages which are only in the archives specified through a
249# regular expression
202sub print_archives_only_regexp 250sub print_archives_only_regexp
203{ 251{
204 my ($archives_regexp,$long) = @_; 252 my ($archives_regexp,$long) = @_;
205 foreach my $package_name (sort keys %installed_packages) { 253 iterate_through_packages(\&print_archives_only_regexp_item, $archives_regexp, $long);
206 foreach my $entry (@{$installed_packages{$package_name}}) { 254}
207 if ($entry->{status} eq 'install ok installed') { 255
256# Callback: print an entry if it is only in the archives specified through a
257# regular expression
258sub print_archives_only_regexp_item
259{
260 my ($entry, $archives_regexp, $long) = @_;
208 my $valid = 1; 261 my $valid = 1;
209 my $nr=0;
210 foreach my $list (@{$entry->{lists}}) { 262 foreach my $list (@{$entry->{lists}}) {
211 $nr++;
212 if (! ($list =~ /$archives_regexp/)) { 263 if (! ($list =~ /$archives_regexp/)) {
213 $valid = 0; 264 $valid = 0;
214 last; 265 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 } 266 }
225 } 267 }
268 if ($valid and @{$entry->{lists}}) {
269 print_item($entry, $long)
270 }
271}
272
273# Print those packages which are not in the specified archives
274sub print_archives_except
275{
276 my ($archives,$long) = @_;
277 my %archives;
278 foreach my $archive (split (/,/,$archives)) {
279 $archives{$archive} = 1;
280 }
281 iterate_through_packages(\&print_archives_except_item, \%archives, $long);
282}
283
284# Callback: print an entry if it is not in the specified archives
285sub print_archives_except_item
286{
287 my ($entry,$archives, $long) = @_;
288 my $valid = 1;
289 foreach my $list (@{$entry->{lists}}) {
290 if (exists($archives->{$list})) {
291 $valid = 0;
292 last;
226 } 293 }
294 }
295 if ($valid and @{$entry->{lists}}) {
296 print_item($entry, $long)
297 }
227} 298}
228 299
300# Print those packages which are not in the archives specified through a
301# regular expression
302sub print_archives_except_regexp
303{
304 my ($archives_regexp,$long) = @_;
305 iterate_through_packages(\&print_archives_except_regexp_item, $archives_regexp, $long);
306}
307
308# Callback: print an entry if it is not in the archives specified through a
309# regular expression
310sub print_archives_except_regexp_item
311{
312 my ($entry, $archives_regexp, $long) = @_;
313 my $valid = 1;
314 foreach my $list (@{$entry->{lists}}) {
315 if ($list =~ /$archives_regexp/) {
316 $valid = 0;
317 last;
318 }
319 }
320 if ($valid and @{$entry->{lists}}) {
321 print_item($entry, $long)
322 }
323}
229 324
230######################### 325#########################
231# COMMAND LINE HANDLING # 326# COMMAND LINE HANDLING #
232######################### 327#########################
233 328
… …
239 print STDERR " -o: orphans: packages that are not in any archive\n"; 334 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"; 335 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"; 336 print STDERR " archives (seperated by commas)\n";
242 print STDERR " -A ARCHREGEXP: archives: list all packages that are only in archives\n"; 337 print STDERR " -A ARCHREGEXP: archives: list all packages that are only in archives\n";
243 print STDERR " that match the regular expression\n"; 338 print STDERR " that match the regular expression\n";
339 print STDERR " -x ARCHS: except: list all packages that are not in one of the listed\n";
340 print STDERR " archives (seperated by commas)\n";
341 print STDERR " -X ARCHREGEXP: except: list all packages that are not in archives\n";
342 print STDERR " that match the regular expression\n";
244 print STDERR " -l: long: print archives too\n"; 343 print STDERR " -l: long: print archives too\n";
245 344
246 print STDERR "Default: print all packages and sources\n"; 345 print STDERR "Default: print all packages and sources\n";
247} 346}
248 347
… …
259 358
260$Getopt::Std::STANDARD_HELP_VERSION=1; 359$Getopt::Std::STANDARD_HELP_VERSION=1;
261 360
262our $VERSION=$version; 361our $VERSION=$version;
263my %options; 362my %options;
264if (! getopts('hVola:A:',\%options)) 363if (! getopts('hVola:A:x:X:',\%options))
265{ 364{
266 print_help(); 365 print_help();
267 exit 1; 366 exit 1;
268} 367}
269my $long=0; 368my $long=0;
… …
289} 388}
290if ($options{A}) { 389if ($options{A}) {
291 print_archives_only_regexp($options{A},$long); 390 print_archives_only_regexp($options{A},$long);
292 exit 0; 391 exit 0;
293} 392}
393if ($options{x}) {
394 print_archives_except($options{x},$long);
395 exit 0;
396}
397if ($options{X}) {
398 print_archives_except_regexp($options{X},$long);
399 exit 0;
400}
294print_all; 401print_all;
295 402
296 403
297# vim:sw=2:ft=perl:expandtab: 404# vim:sw=2:ft=perl:expandtab:
Legend:
Removed from v.330  
changed lines
  Added in v.333
frodo@frodo.looijaard.name
 ViewVC Help
Powered by ViewVC 1.1.26