added, at the beginning of the oo rewrite

Alien/Package/Deb.pm

@@ -0,0 +1,188 @@
+#!/usr/bin/perl -w
+
+=head1 NAME
+
+Alien::Package::Deb - an object that represents a deb package
+
+=cut
+
+package Alien::Package::Deb;
+use strict;
+use Alien::Package; # perlbug
+use base qw(Alien::Package);
+
+=head1 DESCRIPTION
+
+This is an object class that represents a deb package. It is derived from
+Alien::Package.
+
+=head1 FIELDS
+
+=over 4
+
+=item have_dpkg_deb
+
+Set to a true value if dpkg-deb is available.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item init
+
+Sets have_dpkg_deb if dpkg-deb is in the path.
+
+=cut
+
+sub init {
+	my $this=shift;
+	$this->SUPER::init(@_);
+
+	$this->have_dpkg_deb('');
+	foreach (split(/:/,$ENV{PATH})) {
+		if (-x "$_/dpkg-deb") {
+			$this->have_dpkg_deb(1);
+			last;
+		}
+	}
+}
+
+=item read_file
+
+Implement the read_file method to read a deb file.
+
+This uses either dpkg-deb, if it is present, or ar and tar if it is not.
+Using dpkg-deb is a lot more future-proof, but the system may not have it.
+
+=cut
+
+sub read_file {
+	my $this=shift;
+	$this->SUPER::read_file(@_);
+
+	# Extract the control file from the deb file.
+	my @control;
+	if ($this->have_dpkg_deb) {
+		@control = `dpkg-deb --info $file control`;
+	}
+	else {
+		# It can have one of two names, depending on the tar
+		# version the .deb was built from.
+		@control = `ar p $file control.tar.gz | tar Oxzf - control [./]control`;
+	}
+
+	# Parse control file and extract fields.
+	my $field;
+	my %fieldtrans=(
+		Package => 'name',
+		Version => 'version',
+		Architecture => 'arch',
+		Maintainer => 'maintainer',
+		Depends => 'depends',
+		Section => 'group',
+		Description => 'summary',
+	);
+	for (my $i=0; $i <= $#control; $i++) {
+		$_ = $control[$i];
+		chomp;
+		if (/^(\w.*?):\s+(.*)/) {
+			$field=$1;
+			if (exists $fieldtrans{$field}) {
+				$field=$fieldtrans{$field};
+				$this->$field($2);
+			}
+		}
+		elsif (/^ / && $field eq 'summary') {
+			# Handle xtended description.
+			s/^ //g;
+			$_="" if $_ eq ".";
+			$this->description($this->description . $_. "\n");
+		}
+	}
+
+	$this->copyright("see /usr/share/doc/".$this->name."/copyright");
+	$this->group("unknown") if ! $this->group;
+	$this->distribution("Debian");
+	if ($this->version =~ /(.+)-(.+)/) {
+		$this->version($1);
+		$this->release($2);
+	}
+	else {
+		$this->release(1);
+	}
+	# Kill epochs.
+	if ($this->version =~ /\d+:(.*)/) {
+		$this->version($1);
+	}
+
+	# Read in the list of conffiles, if any.
+	my @conffiles;
+	if ($this->have_dpkg_deb) {
+		@conffiles=map { chomp; $_ }
+			   `dpkg-deb --info $file conffiles 2>/dev/null`;
+	}
+	else {
+		@conffiles=map { chomp; $_ }
+			   `ar p $file control.tar.gz | tar Oxzf - conffiles 2>/dev/null`;
+	}
+	$this->conffiles(\@conffiles);
+
+	# Read in the list of all files.
+	# Note that tar doesn't supply a leading `/', so we have to add that.
+	my @filelist;
+	if ($this->have_dpkg_deb) {
+		@filelist=map { chomp; s:\./::; "/$_" }
+			  `dpkg-deb --fsys-tarfile $file | tar tf -`;
+	}
+	else {
+		@filelist=map { chomp; s:\./::; "/$_" }
+			  `ar p $file data.tar.gz | tar tzf -`;
+	}
+	$this->filelist(\@filelist);
+
+	# Read in the scripts, if any.
+	foreach my $field (qw{postinst postrm preinst prerm}) {
+		if ($this->have_dpkg_deb) {
+			$this->$field(`dpkg-deb --info $file $field 2>/dev/null`);
+		}
+		else {
+			$this->$field(`ar p $file control.tar.gz | tar Oxzf - $field 2>/dev/null`);
+		}
+	}
+
+	return 1;
+}
+
+=item unpack
+
+Implment the unpack method to unpack a deb file.
+
+=cut
+
+sub unpack {
+	my $this=shift;
+	$this->SUPER::unpack(@_);
+
+	if ($this->have_dpkg_deb) {
+		system("dpkg-deb -x $file ".$this->unpacked_tree) &&
+			die "Unpacking of `$file' failed: $!";
+	}
+	else {
+		system ("ar p $file data.tar.gz | (cd ".$this->unpacked_tree."; tar zxpf -)") &&
+			die "Unpacking of `$file' failed: $!";
+	}
+
+	return 1;
+}
+
+=back
+
+=head1 AUTHOR
+
+Joey Hess <joey@kitenet.net>
+
+=cut
+
+1