--- apt-installed-status/trunk/apt-installed-status 2014/06/12 08:41:58 330 +++ apt-installed-status/trunk/apt-installed-status 2014/06/17 09:54:05 333 @@ -1,10 +1,28 @@ #!/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'; @@ -144,30 +162,63 @@ # OUTPUT DATA # ############### -sub print_orphans -{ - foreach my $package_data (values %installed_packages) { - foreach my $entry (@$package_data) { +# 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') { - if (! @{$entry->{lists}}) { - print $entry->{package}."\t".$entry->{architecture}."\t".$entry->{version}."\n"; - } + &$sub($entry, @params) } } } } -sub print_all +# 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 { - 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"; - } - } + 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 +226,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,6 +336,10 @@ 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 "Default: print all packages and sources\n"; @@ -261,7 +360,7 @@ our $VERSION=$version; my %options; -if (! getopts('hVola:A:',\%options)) +if (! getopts('hVola:A:x:X:',\%options)) { print_help(); exit 1; @@ -291,6 +390,14 @@ print_archives_only_regexp($options{A},$long); exit 0; } +if ($options{x}) { + print_archives_except($options{x},$long); + exit 0; +} +if ($options{X}) { + print_archives_except_regexp($options{X},$long); + exit 0; +} print_all;