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

Alien/Package/Rpm.pm

@@ -0,0 +1,154 @@
+#!/usr/bin/perl -w
+
+=head1 NAME
+
+Alien::Package::Rpm - an object that represents a rpm package
+
+=cut
+
+package Alien::Package::Rpm;
+use strict;
+use Alien::Package; # perlbug
+use base qw(Alien::Package);
+
+=head1 DESCRIPTION
+
+This is an object class that represents a rpm package. It is derived from
+Alien::Package.
+
+=head1 FIELDS
+
+=over 4
+
+=item prefixes
+
+Relocatable rpm packages have a prefixes field.
+
+=item changelogtext
+
+The text of the changelog
+
+=head1 METHODS
+
+=over 4
+
+=item read_file
+
+Implement the read_file method to read a rpm file.
+
+=cut
+
+sub read_file {
+	my $this=shift;
+	$this->SUPER::read_file(@_);
+	my $file=$this->filename;
+
+	my %fieldtrans=(
+		PREIN => 'preinst',
+		POSTIN => 'postinst',
+		PREUN => 'prerm',
+		POSTUN => 'postrm',
+	);
+
+	# These fields need no translation except case.
+	foreach (qw{name version release arch changelogtext summary
+		    description copyright prefixes}) {
+		$fieldtrans{uc $_}=$_;
+	}
+
+	# Use --queryformat to pull out all the fields we need.
+	foreach my $field (keys(%fieldtrans)) {
+		$_=`LANG=C rpm -qp $file --queryformat \%{$field}`;
+		$field=$fieldtrans{$field};
+		$this->$field($_) if $_ ne '(none)';
+	}
+
+	# Fix up the scripts - they are always shell scripts, so make them so.
+	foreach my $field (qw{preinst postinst prerm postrm}) {
+		$this->$field("$!/bin/sh\n".$this->field);
+	}
+
+	# Get the conffiles list.
+	$this->conffiles([map { chomp; $_ } `rpm -qcp $file`]);
+
+	$this->copyright_extra(scalar `rpm -qpi $file`);
+
+	# Get the filelist.
+	$this->filelist([map { chomp; $_ } `rpm -qpl $file`]);
+
+	# Sanity check and sanitize fields.
+	unless (defined $this->summary) {
+		# Older rpms will have no summary, but will have a
+		# description. We'll take the 1st line out of the
+		# description, and use it for the summary.
+		$this->summary($this->description."\n")=~m/(.*?)\n/m;
+
+		# Fallback.
+		if (! $this->summary) {
+			$this->summary('Converted RPM package');
+		}
+	}
+	unless (defined $this->copyright) {
+		$this->copyright('unknown');
+	}
+	unless (defined $this->description) {
+		$this->description($this->summary);
+	}
+	if (! defined $this->release || ! defined $this->version || 
+	    ! defined $this->name) {
+		die "Error querying rpm file";
+	}
+
+	$this->distribution("Red Hat");
+
+	return 1;
+}
+
+=item arch
+
+Set/get arch field. When the arch field is set, some sanitizing is done
+first.
+
+=cut
+
+sub arch {
+	my $this=shift;
+	return $this->{arch} unless @_;
+	my $arch=shift;
+
+	if ($arch eq 1) {
+		$arch='i386';
+	}
+	elsif ($arch eq 2) {
+		$arch='alpha';
+	}
+	elsif ($arch eq 3) {
+		$arch='sparc';
+	}
+	elsif ($arch eq 6) {
+		$arch='m68k';
+	}
+	elsif ($arch eq 'noarch') {
+		$arch='all';
+	}
+	elsif ($arch eq 'ppc') {
+		$arch='powerpc';
+	}
+	
+	# Treat 486, 586, etc, as 386.
+	if ($arch =~ m/i\d86/) {
+		$arch='i386';
+	}
+	
+	return $this->{arch}=$arch;
+}
+
+=back
+
+=head1 AUTHOR
+
+Joey Hess <joey@kitenet.net>
+
+=cut
+
+1