/[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 332 Revision 337
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 25
6use Data::Dumper;
7
8my $execname = 'apt-installed-status'; 26my $execname = 'apt-installed-status';
9my $version = '1.0'; 27my $version = '1.1';
10 28
11 29
12########################## 30##########################
13# HANDLE DATA COLLECTION # 31# HANDLE DATA COLLECTION #
14########################## 32##########################
… …
33# 'package': string: package name (same as the primary hash key) 51# 'package': string: package name (same as the primary hash key)
34# 'architecture': string: architecture 52# 'architecture': string: architecture
35# 'version': string: version 53# 'version': string: version
36# 'multiarch': string: package multi-arch option (not always available) 54# 'multiarch': string: package multi-arch option (not always available)
37my %package_lists; 55my %package_lists;
56
57# 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
60my @archive_names;
38 61
39 62
40# Read a package list file and save it into global variable %package_lists. 63# 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 64# Parameter 1: $file: File name (within /var/lib/apt/lists) of the package list
42# Returns: Nothing 65# Returns: Nothing
… …
137 read_installed_packages(); 160 read_installed_packages();
138 read_all_package_lists(); 161 read_all_package_lists();
139 find_all_packages(); 162 find_all_packages();
140} 163}
141 164
165# Determine which package archives are available.
166# Parameters: None
167# Returns: Nothing
168# Side effects: Fills in global variabale @archive_names
169sub 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
142 178
143############### 179###############
144# OUTPUT DATA # 180# OUTPUT DATA #
145############### 181###############
182
183sub print_archive_names
184{
185 print join("\n", sort @archive_names)."\n";
186}
187
188sub 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
198sub print_archive_names_only_regexp
199{
200 my ($archives_regexp) = @_;
201 print join("\n", sort (grep /$archives_regexp/,@archive_names))."\n";
202}
203
204sub 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
214sub print_archive_names_except_regexp
215{
216 my ($archives_regexp) = @_;
217 print join("\n", sort (grep !/$archives_regexp/,@archive_names))."\n";
218}
146 219
147# Go through the list of all packages and call a subroutine on each installed 220# Go through the list of all packages and call a subroutine on each installed
148# package. 221# package.
149# Parameter 1: $sub: Reference to the subroutine to call 222# Parameter 1: $sub: Reference to the subroutine to call
150# Each call gets two parameters: the entry and $long 223# Each call gets two parameters: the entry and $long
… …
321 print STDERR " -x ARCHS: except: list all packages that are not in one of the listed\n"; 394 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"; 395 print STDERR " archives (seperated by commas)\n";
323 print STDERR " -X ARCHREGEXP: except: list all packages that are not in archives\n"; 396 print STDERR " -X ARCHREGEXP: except: list all packages that are not in archives\n";
324 print STDERR " that match the regular expression\n"; 397 print STDERR " that match the regular expression\n";
325 print STDERR " -l: long: print archives too\n"; 398 print STDERR " -l: long: print archives too\n";
399 print STDERR " -L: list: print archives that are selected instead of packages\n";
326 400
327 print STDERR "Default: print all packages and sources\n"; 401 print STDERR "Default: print all packages and sources\n";
328} 402}
329 403
330sub print_version 404sub print_version
… …
340 414
341$Getopt::Std::STANDARD_HELP_VERSION=1; 415$Getopt::Std::STANDARD_HELP_VERSION=1;
342 416
343our $VERSION=$version; 417our $VERSION=$version;
344my %options; 418my %options;
345if (! getopts('hVola:A:x:X:',\%options)) 419if (! getopts('hVoLla:A:x:X:',\%options))
346{ 420{
347 print_help(); 421 print_help();
348 exit 1; 422 exit 1;
349} 423}
350my $long=0; 424my $long=0;
425my $names_only=0;
426
351if ($options{'h'}) { 427if ($options{'h'}) {
352 print_help(); 428 print_help();
353 exit 0; 429 exit 0;
354} 430}
355if ($options{'V'}) { 431if ($options{'V'}) {
356 print_version(); 432 print_version();
357 exit 0; 433 exit 0;
358} 434}
435if ($options{'L'}) {
436 $names_only=1;
437}
438if ($names_only) {
439 init_names();
440} else {
359init(); 441 init();
442}
360if ($options{'o'}) { 443if ($options{'o'}) {
361 print_orphans(); 444 print_orphans();
362 exit 0; 445 exit 0;
363} 446}
364if ($options{l}) { 447if ($options{l}) {
365 $long = 1; 448 $long = 1;
366} 449}
367if ($options{a}) { 450if ($options{a}) {
451 if ($names_only) {
452 print_archive_names_only($options{a});
453 } else {
368 print_archives_only($options{a},$long); 454 print_archives_only($options{a},$long);
455 }
369 exit 0; 456 exit 0;
370} 457}
371if ($options{A}) { 458if ($options{A}) {
459 if ($names_only) {
460 print_archive_names_only_regexp($options{A});
461 } else {
372 print_archives_only_regexp($options{A},$long); 462 print_archives_only_regexp($options{A},$long);
463 }
373 exit 0; 464 exit 0;
374} 465}
375if ($options{x}) { 466if ($options{x}) {
467 if ($names_only) {
468 print_archive_names_except($options{x});
469 } else {
376 print_archives_except($options{x},$long); 470 print_archives_except($options{x},$long);
471 }
377 exit 0; 472 exit 0;
378} 473}
379if ($options{X}) { 474if ($options{X}) {
475 if ($names_only) {
476 print_archive_names_except($options{X});
477 } else {
380 print_archives_except_regexp($options{X},$long); 478 print_archives_except_regexp($options{X},$long);
479 }
381 exit 0; 480 exit 0;
382} 481}
482if ($names_only) {
483 print_archive_names()
484} else {
383print_all; 485 print_all();
486}
384 487
385 488
386# vim:sw=2:ft=perl:expandtab: 489# vim:sw=2:ft=perl:expandtab:
Legend:
Removed from v.332  
changed lines
  Added in v.337
frodo@frodo.looijaard.name
 ViewVC Help
Powered by ViewVC 1.1.26