Re: Uploaded dpkg-awk 0.7 (source all) to master

[Ben Gertzfield <che@debian.org>]

>>>>> "Jason" == Jason Gunthorpe <jgg@gpu.srv.ualberta.ca> writes:

    Jason> Or the perl dpkg routines.. etc.

    Jason> An interesting project for someone would be to write a
    Jason> usefull shell parsable command line information grabber for
    Jason> dpkg (possibly using APT's library)

Just for kicks, I've written a small Perl module that lets you know if
a package is installed with an is_installed() method, and returns the
current status of any package in a hash (or a scalar, if called in
scalar context) with a status() method.

Here it is:

#!/usr/bin/perl -w

				# Debian::Status.pm
				# written July 1998 by 
				# Ben Gertzfield <che@debian.org>
				# This file is released under the
				# GNU General Public License,
				# version 2 or later.

my $file = '/var/lib/dpkg/status';

sub is_installed ($) {
  my $package = shift;
  
  my %status = status($package);

  if ($status{'Status'} =~ /^install ok installed$/) {
    return 1;
  } else {
    return undef;
  }
}

sub status ($) {
  my $package = shift;
  
  my (%status, $status);

  open (STATUS, $file) or die "Couldn't open $file for reading: $!\n";
 FINDPACKAGE:
  while (<STATUS>) {
    chomp;
    if (/^Package: \Q$package\E$/) {
      $status{'Package'} = $package;
      $status .= "Package: $package\n";
      my $header;
    INPACKAGE:
      for (;;) {
	my $line = <STATUS>;
	if (defined $line) {
	  $status .= $line;
	  chomp $line;
	  last FINDPACKAGE if $line =~ /^\s*$/;
	} else {
	  last FINDPACKAGE;
	}

	if ($line =~ /^([\w\-]+):\s+(.*)/) {
	  $header = $1;
	  $status{$header} .= "$2\n";
	} elsif (not defined $header) { # This should never happen
	  warn "Malformed status file $file: $line line $.\n";
	  last INPACKAGE;
	} else {
	  $line =~ s/^\s*//;
	  $status{$header} .= "$line\n";
	}
      }
    }
  }

  close STATUS;

  return wantarray ? %status : $status;
}

__END__

=head1 NAME

Debian::Status.pm - get information from status/available/packages files

=head1 SYNOPSIS

  use Debian::Status;

  my $is_installed = is_installed('packagename');

  $Debian::Status::file = '/var/lib/dpkg/status'; # default

  if ($is_installed) {
    my %status = status('packagename');
    print $status{'Priority'}, $status{'Section'}, "\n";
  }    

  my $status_string = status('packagename'); # In scalar context
  

=head1 DESCRIPTION

The C<Debian::Status> module is useful to retrieve information from the
Debian database system about what packages are installed and information
about the packages that are installed.

C<Debian::Status> provides the following methods:

=over 4

=item is_installed ( PACKAGENAME )

C<is_installed> looks at /var/lib/dpkg/available to determine if the
package C<PACKAGENAME> is installed and returns I<true> if the package
is installed and I<undef> otherwise.

=item status ( PACKAGENAME )

C<status> looks at the current status of C<PACKAGENAME> as defined in
C</var/lib/dpkg/available> (by default; you may change this in
C<$Debian::Status::file>) and returns, if called in list context,
a hash containing key/value pairs of a status field name and the
field's contents for C<PACKAGENAME>.

If C<sstatus> is called in scalar context, it simply returns a string
containing all the information for the package C<PACKAGENAME> as
defined in C<$Debian::Status::file>.

=back

=cut


--  
To UNSUBSCRIBE, email to debian-devel-request@lists.debian.org
with a subject of "unsubscribe". Trouble? Contact listmaster@lists.debian.org