Annotation of /apt-installed-status/trunk/apt-installed-status

#!/usr/bin/perl -w

use strict;
use Getopt::Std;

use Data::Dumper;

my $execname = 'apt-installed-status';
my $version = '1.0';


##########################
# HANDLE DATA COLLECTION #
##########################

# Global variables to hold data about all currently installed packages and
# all available packages in apt archives.

# installed_packages: hash 
#   package name: reference to array
#     counter: reference to hash
#       'package': string: package name (same as the primary hash key)
#       'binpackage': string: binary package name (may contain architecture)
#       'architecture': string: architecture
#       'version': string: version
#       'status': string: package status
my %installed_packages;

# package_lists: hash 
#   list: reference to hash
#     package name: reference to array
#       counter: reference to hash
#         'package': string: package name (same as the primary hash key)
#         'architecture': string: architecture
#         'version': string: version
#         'multiarch': string: package multi-arch option (not always available)
my %package_lists;


# 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
# Returns: Nothing
# Side effects: Fills in global variabale $package_lists{$file}
sub read_package_list
{
  my ($file) = @_;
  my ($entry,$package);
  open(FILE, '/var/lib/apt/lists/'.$file) or die "Can't open $file: $!";
  while (<FILE>) {
    chomp;
    ($package) = /^Package:\s*(.*)$/ if /^Package:/;
    ($entry->{'architecture'}) = /^Architecture:\s*(.*)$/ if /^Architecture:/;
    ($entry->{'version'}) = /^Version:\s*(.*)$/ if /^Version:/;
    ($entry->{'multiarch'}) = /^Multi-Arch:\s*(.*)$/ if /^Multi-Arch:/;
    if (/^\s*$/ and defined($package)) {
      $entry->{'package'} = $package;
      push (@{$package_lists{$file}->{$package}}, $entry);
      undef($entry);
      undef($package);
    }
  }
  if (defined($entry)) {
    push (@{$package_lists{$file}->{$package}}, $entry);
  }
  close(FILE);
}

# Read all package list files and save them into global variable %package_lists.
# Parameters: None
# Returns: Nothing
# Side effects: Fills in global variabale $package_lists
sub read_all_package_lists
{
  opendir(DIR, '/var/lib/apt/lists') or die "Can't opendir: $!";
  while (defined(my $file = readdir(DIR))) {
    read_package_list($file) if $file =~ /_Packages$/
  }
  closedir(DIR);
}

# Read all installed packages and save them into global variable %installed_packages
# Parameters: None
# Returns: Nothing
# Side effects: Fills in global variabale $package_lists
sub read_installed_packages
{
  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: $!";
  while (<FILE>) {
    chomp;
    my ($status, $package, $binpackage,$version,$architecture) = split "\t";
    push @{$installed_packages{$package}},{ 'status' => $status, 
                                      'binpackage' => $binpackage, 
                                      'version' => $version, 
                                      'package' => $package,
                                      'architecture' => $architecture };
  }
  close FILE;
}

# Try to locate a package in the archive lists, matching name, architecture
#   and version.
# Parameters: $package_data: reference to a hash containing the package data
# Returns: An array of lists in which this package is available
sub find_package
{
  my ($package_data) = @_;
  my @lists_found = ();
  foreach my $listname (keys %package_lists) {
    if (exists ($package_lists{$listname}->{$package_data->{'package'}})) {
      foreach my $entry (@{$package_lists{$listname}->{$package_data->{'package'}}}) {
        if ($entry->{'architecture'} eq $package_data->{'architecture'} and $entry->{'version'} eq $package_data->{'version'}) {
          push @lists_found,$listname;
          last;
        }
      }
    }
  }
  return \@lists_found;
}

# Determine for all installed packages in which archives they are found
# Parameters: None
# Returns: Nothing
# Side effects: Fills in global variabale $installed_packages
sub find_all_packages
{
  foreach my $package_name (keys %installed_packages) {
    foreach my $entry (@{$installed_packages{$package_name}}) {
      $entry->{'lists'} = find_package($entry);
    }
  }
}

# Fill all global variables
sub init
{
  read_installed_packages();
  read_all_package_lists();
  find_all_packages();
}


###############
# OUTPUT DATA #
###############

sub print_orphans
{
  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";
        }
      }
    }
  }
}

sub print_all
{
  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 print_archives_only
{
  my ($archives,$long) = @_;
  my %archives;
  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";
          }
        }
      }
    }
  }
}

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";
          }
        }
      }
    }
  }
}


#########################
# COMMAND LINE HANDLING #
#########################

sub print_help
{
  print STDERR "$execname [OPTION]\n";
  print STDERR "  -h: help text and exit\n";
  print STDERR "  -V: print version and exit\n";
  print STDERR "  -o: orphans: packages that are not in any archive\n";
  print STDERR "  -a ARCHS: archives: list all packages that are only in one of the listed\n";
  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 "  -l: long: print archives too\n";

  print STDERR "Default: print all packages and sources\n";
}

sub print_version 
{
  print STDERR "$execname $version\n";
}

sub HELP_MESSAGE
{
  print_help();
  exit 0;
}

$Getopt::Std::STANDARD_HELP_VERSION=1;

our $VERSION=$version;
my %options;
if (! getopts('hVola:A:',\%options))
{
  print_help();
  exit 1;
}
my $long=0;
if ($options{'h'}) {
  print_help();
  exit 0;
}
if ($options{'V'}) {
  print_version();
  exit 0;
}
init();
if ($options{'o'}) {
  print_orphans();
  exit 0;
}
if ($options{l}) {
  $long = 1;
}
if ($options{a}) {
  print_archives_only($options{a},$long);
  exit 0;
}
if ($options{A}) {
  print_archives_only_regexp($options{A},$long);
  exit 0;
}
print_all;


# vim:sw=2:ft=perl:expandtab:
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:
frodo@frodo.looijaard.name	ViewVC Help
Powered by ViewVC 1.1.26