--- apt-installed-status/trunk/apt-installed-status 2014/06/12 08:41:58 330 +++ apt-installed-status/trunk/apt-installed-status 2014/07/04 15:50:28 337 @@ -1,12 +1,30 @@ #!/usr/bin/perl -w +# Copyright (c) 2014 by Frodo Looijaard +# +# License: GPL-3.0+ +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# . +# This package is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# . +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +# . +# On Debian systems, the complete text of the GNU General +# Public License version 3 can be found in "/usr/share/common-licenses/GPL-3". + + use strict; use Getopt::Std; -use Data::Dumper; - my $execname = 'apt-installed-status'; -my $version = '1.0'; +my $version = '1.1'; ########################## @@ -36,6 +54,11 @@ # 'multiarch': string: package multi-arch option (not always available) my %package_lists; +# When only the names of the package lists is asked for, we fill this variable. +# archives: array +# counter: string: name of the archive +my @archive_names; + # Read a package list file and save it into global variable %package_lists. # Parameter 1: $file: File name (within /var/lib/apt/lists) of the package list @@ -139,35 +162,118 @@ find_all_packages(); } +# Determine which package archives are available. +# Parameters: None +# Returns: Nothing +# Side effects: Fills in global variabale @archive_names +sub init_names +{ + opendir(DIR, '/var/lib/apt/lists') or die "Can't opendir: $!"; + while (defined(my $file = readdir(DIR))) { + push (@archive_names,$file) if $file =~ /_Packages$/ + } + closedir(DIR); +} + ############### # OUTPUT DATA # ############### -sub print_orphans +sub print_archive_names { - foreach my $package_data (values %installed_packages) { - foreach my $entry (@$package_data) { - if ($entry->{status} eq 'install ok installed') { - if (! @{$entry->{lists}}) { - print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n"; - } - } - } + print join("\n", sort @archive_names)."\n"; +} + +sub print_archive_names_only +{ + my ($archives) = @_; + my %archives; + foreach my $archive (split (/,/,$archives)) { + $archives{$archive} = 1; + } + print join("\n", sort (grep { exists $archives{$_} } @archive_names))."\n"; +} + +sub print_archive_names_only_regexp +{ + my ($archives_regexp) = @_; + print join("\n", sort (grep /$archives_regexp/,@archive_names))."\n"; +} + +sub print_archive_names_except +{ + my ($archives) = @_; + my %archives; + foreach my $archive (split (/,/,$archives)) { + $archives{$archive} = 1; } + print join("\n", sort (grep { ! exists $archives{$_} } @archive_names))."\n"; } -sub print_all +sub print_archive_names_except_regexp { + my ($archives_regexp) = @_; + print join("\n", sort (grep !/$archives_regexp/,@archive_names))."\n"; +} + +# Go through the list of all packages and call a subroutine on each installed +# package. +# Parameter 1: $sub: Reference to the subroutine to call +# Each call gets two parameters: the entry and $long +# Parameter 2..: @params: All other parameters +# Returns: Nothing +# Side effects: Generates output on STDOUT +sub iterate_through_packages { + my ($sub, @params) = @_; foreach my $package_name (sort keys %installed_packages) { foreach my $entry (@{$installed_packages{$package_name}}) { if ($entry->{status} eq 'install ok installed') { - print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n"; + &$sub($entry, @params) } } } } +# Print an entry, either with or without its archives +# Parameter 1: $entry: a hash reference containing keys package, architecture +# and version (as well as lists if $long is true) +# Parameter 2: $long: whether to print the archives too +# Returns: nothing +# Side effects: Generates output on STDOUT +sub print_item +{ + my ($entry, $long) = @_; + if ($long) { + print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n"; + } else { + print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n"; + } +} + +# Print all packages, including archives +sub print_all +{ + iterate_through_packages(\&print_item, 1); +} + + +# Print only those packages that have no archive associated with them +sub print_orphans +{ + iterate_through_packages(\&print_orphans_item); +} + +# Callback: check whether an entry is an orphan and if so print it +sub print_orphans_item +{ + my ($entry) = @_; + if (! @{$entry->{lists}}) { + print_item($entry, 0); + } +} + +# Print those packages which are only in the specified archives sub print_archives_only { my ($archives,$long) = @_; @@ -175,57 +281,101 @@ foreach my $archive (split (/,/,$archives)) { $archives{$archive} = 1; } - foreach my $package_name (sort keys %installed_packages) { - foreach my $entry (@{$installed_packages{$package_name}}) { - if ($entry->{status} eq 'install ok installed') { - my $valid = 1; - my $nr=0; - foreach my $list (@{$entry->{lists}}) { - $nr++; - if (! exists($archives{$list})) { - $valid = 0; - last; - } - } - if ($valid and $nr) { - if ($long) { - print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n"; - } else { - print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n"; - } - } - } + iterate_through_packages(\&print_archives_only_item, \%archives, $long); +} + +# Callback: print an entry if it is only in the specified archives +sub print_archives_only_item +{ + my ($entry,$archives, $long) = @_; + my $valid = 1; + foreach my $list (@{$entry->{lists}}) { + if (! exists($archives->{$list})) { + $valid = 0; + last; } } + if ($valid and @{$entry->{lists}}) { + print_item($entry, $long) + } } +# Print those packages which are only in the archives specified through a +# regular expression sub print_archives_only_regexp { my ($archives_regexp,$long) = @_; - foreach my $package_name (sort keys %installed_packages) { - foreach my $entry (@{$installed_packages{$package_name}}) { - if ($entry->{status} eq 'install ok installed') { - my $valid = 1; - my $nr=0; - foreach my $list (@{$entry->{lists}}) { - $nr++; - if (! ($list =~ /$archives_regexp/)) { - $valid = 0; - last; - } - } - if ($valid and $nr) { - if ($long) { - print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\t".join(',',@{$entry->{lists}})."\n"; - } else { - print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n"; - } - } - } + iterate_through_packages(\&print_archives_only_regexp_item, $archives_regexp, $long); +} + +# Callback: print an entry if it is only in the archives specified through a +# regular expression +sub print_archives_only_regexp_item +{ + my ($entry, $archives_regexp, $long) = @_; + my $valid = 1; + foreach my $list (@{$entry->{lists}}) { + if (! ($list =~ /$archives_regexp/)) { + $valid = 0; + last; + } + } + if ($valid and @{$entry->{lists}}) { + print_item($entry, $long) + } +} + +# Print those packages which are not in the specified archives +sub print_archives_except +{ + my ($archives,$long) = @_; + my %archives; + foreach my $archive (split (/,/,$archives)) { + $archives{$archive} = 1; + } + iterate_through_packages(\&print_archives_except_item, \%archives, $long); +} + +# Callback: print an entry if it is not in the specified archives +sub print_archives_except_item +{ + my ($entry,$archives, $long) = @_; + my $valid = 1; + foreach my $list (@{$entry->{lists}}) { + if (exists($archives->{$list})) { + $valid = 0; + last; } } + if ($valid and @{$entry->{lists}}) { + print_item($entry, $long) + } +} + +# Print those packages which are not in the archives specified through a +# regular expression +sub print_archives_except_regexp +{ + my ($archives_regexp,$long) = @_; + iterate_through_packages(\&print_archives_except_regexp_item, $archives_regexp, $long); } +# Callback: print an entry if it is not in the archives specified through a +# regular expression +sub print_archives_except_regexp_item +{ + my ($entry, $archives_regexp, $long) = @_; + my $valid = 1; + foreach my $list (@{$entry->{lists}}) { + if ($list =~ /$archives_regexp/) { + $valid = 0; + last; + } + } + if ($valid and @{$entry->{lists}}) { + print_item($entry, $long) + } +} ######################### # COMMAND LINE HANDLING # @@ -241,7 +391,12 @@ print STDERR " archives (seperated by commas)\n"; print STDERR " -A ARCHREGEXP: archives: list all packages that are only in archives\n"; print STDERR " that match the regular expression\n"; + print STDERR " -x ARCHS: except: list all packages that are not in one of the listed\n"; + print STDERR " archives (seperated by commas)\n"; + print STDERR " -X ARCHREGEXP: except: list all packages that are not in archives\n"; + print STDERR " that match the regular expression\n"; print STDERR " -l: long: print archives too\n"; + print STDERR " -L: list: print archives that are selected instead of packages\n"; print STDERR "Default: print all packages and sources\n"; } @@ -261,12 +416,14 @@ our $VERSION=$version; my %options; -if (! getopts('hVola:A:',\%options)) +if (! getopts('hVoLla:A:x:X:',\%options)) { print_help(); exit 1; } my $long=0; +my $names_only=0; + if ($options{'h'}) { print_help(); exit 0; @@ -275,7 +432,14 @@ print_version(); exit 0; } -init(); +if ($options{'L'}) { + $names_only=1; +} +if ($names_only) { + init_names(); +} else { + init(); +} if ($options{'o'}) { print_orphans(); exit 0; @@ -284,14 +448,42 @@ $long = 1; } if ($options{a}) { - print_archives_only($options{a},$long); + if ($names_only) { + print_archive_names_only($options{a}); + } else { + print_archives_only($options{a},$long); + } exit 0; } if ($options{A}) { - print_archives_only_regexp($options{A},$long); + if ($names_only) { + print_archive_names_only_regexp($options{A}); + } else { + print_archives_only_regexp($options{A},$long); + } exit 0; } -print_all; +if ($options{x}) { + if ($names_only) { + print_archive_names_except($options{x}); + } else { + print_archives_except($options{x},$long); + } + exit 0; +} +if ($options{X}) { + if ($names_only) { + print_archive_names_except($options{X}); + } else { + print_archives_except_regexp($options{X},$long); + } + exit 0; +} +if ($names_only) { + print_archive_names() +} else { + print_all(); +} # vim:sw=2:ft=perl:expandtab: