Added checkfile class method.

Alien/Package.pm

@@ -155,6 +155,20 @@ having to write your own new() method.
 
 sub init {}
 
+=item checkfile
+
+This is a class method. Pass it a filename, and it will return true if it
+looks like the file is a package of the type handled by the class.
+
+=cut
+
+sub checkfile {
+	my $this=shift;
+	my $file=shift;
+
+	return ''; # children override this.
+}
+
 =item install
 
 Simply installs a package file. The filename is passed on standard input.

Alien/Package/Deb.pm

@@ -50,6 +50,19 @@ sub init {
 	}
 }
 
+=item checkfile
+
+Detect deb files by their extention.
+
+=cut
+
+sub checkfile {
+	my $this=shift;
+	my $file=shift;
+
+	return $file =~ m/.*\.deb$/;
+}
+
 =item install
 
 Install a deb with dpkg. Pass in the filename of the deb to install.

Alien/Package/Rpm.pm

@@ -28,6 +28,19 @@ Relocatable rpm packages have a prefixes field.
 
 =over 4
 
+=item checkfile
+
+Detect rpm files by their extention.
+
+=cut
+
+sub checkfile {
+	my $this=shift;
+	my $file=shift;
+
+	return $file =~ m/.*\.rpm$/;
+}
+
 =item install
 
 Install a rpm. If RPMINSTALLOPT is set in the environement, the options in

Alien/Package/Slp.pm

@@ -92,6 +92,19 @@ Holds the slp package format version of the slp file.
 
 =over 4
 
+=item checkfile
+
+Detect slp files by their extention.
+
+=cut
+
+sub checkfile {
+        my $this=shift;
+        my $file=shift;
+
+        return $file =~ m/.*\.slp$/;
+}
+
 =item install
 
 Install a slp. Pass in the filename of the slp to install.

Alien/Package/Tgz.pm

@@ -45,6 +45,19 @@ use constant
 
 =over 4
 
+=item checkfile
+
+Detect tgz files by their extention.
+
+=cut
+
+sub checkfile {
+        my $this=shift;
+        my $file=shift;
+
+        return $file =~ m/.*\.(?:tgz|tar\.(?:gz|Z|z)|taz)$/;
+}
+
 =item install
 
 Install a tgz with installpkg. Pass in the filename of the tgz to install.
@@ -171,14 +184,14 @@ sub prep {
 
 	my $install_made=0;
 	foreach my $script (keys %{scriptrans()}) {
-		my $data=$this->$script;
+		my $data=$this->$script();
 		next if ! defined $data || $data =~ m/^\s*$/;
 		if (!$install_made) {
 			mkdir $this->unpacked_tree."/install", 0755;
 			$install_made=1;
 		}
-		open OUT (">".$this->unpacked_tree."/install/$script") ||
+		open (OUT, ">".$this->unpacked_tree."/install/$script") ||
-			die $this->unpacked_tree."/install/$script: $!"
+			die $this->unpacked_tree."/install/$script: $!";
 		print OUT $data;
 		close OUT;
 		chmod 0755, $this->unpacked_tree."/install/$script";

lib/Alien.pm

@@ -6,68 +6,25 @@ package Alien;
 
 use strict;
 
-# Print out a status line.
-sub Status { my $message=shift;
-	print "-- $message\n";
-}
-
-# Print out an error message and exit the program.
-sub Error { my $message=shift;
-	print STDERR "alien: $message\n";
-	exit 1;
-}
-
-# Run a system command, and print an error message if it fails.
-# The errormessage parameter is optional.
-sub SafeSystem { my ($command,$errormessage)=@_;
-	my $ret=system $command;
-	if (int($ret/256) > 0) {
-		$errormessage="Error running: $command" if !$errormessage;
-		Error($errormessage);
-	}
-}
-
-# Make the passed directory. Exits with error if the directory already
-# exists.
-sub SafeMkdir { my ($dir)=@_;
-	if (-e $dir) {
-        	Error("Directory $dir already exists.\nRemove it and re-run alien.");
-	}
-	mkdir $dir,0755 || Error("Unable to make directory, \"$dir\": $!");
-}
-
-# Pass the filename of a package.
-# Returns "rpm" or "tgz" or "deb", depending on what it thinks the file type
-# is, based on the filename.
-# Perhaps this should call file(1), instead?
-#
-# Note that the file type this returns corresponds to directories in 
-# $libdir.
-sub FileType { my $file=shift;
-	if ($file=~m/.*\.rpm/ ne undef) {
-		return 'rpm';
-	}	
-	elsif ($file=~m/.*\.(tgz|tar\.gz)/ ne undef) {
-		return 'tgz';
-	}
-	elsif ($file=~m/.*\.deb/ ne undef) {
-		return 'deb';
-	}
-	else {
-		Error("Format of filename bad: $file");
-	}
-}
 
 # Pass this the name and version and revision of a package, it will return the 
 # filename of a patch file for the package or undef if there is none.
 sub GetPatch { my ($name,$version,$revision)=@_;
-	my @patches=glob("$main::patchdir/$name\_$version-$revision*.diff.gz");
+	my @patches=();
+	my $dir;
+	foreach $dir (@main::patchdirs) {
+		push @patches,glob("$dir/$name\_$version-$revision*.diff.gz");
+	}
 	if ($#patches < 0) {
 		# try not matching the revision, see if that helps.
-		@patches=glob("$main::patchdir/$name\_$version*.diff.gz");
+		foreach $dir (@main::patchdirs) {
+			push @patches,glob("$dir/$name\_$version*.diff.gz");
+		}
 		if ($#patches < 0) {
 			# fallback to anything that matches the name.
-			@patches=glob("$main::patchdir/$name\_*.diff.gz");
+			foreach $dir (@main::patchdirs) {
+				push @patches,glob("$dir/$name\_*.diff.gz");
+			}
 		}
 	}
 
@@ -75,101 +32,4 @@ sub GetPatch { my ($name,$version,$revision)=@_;
 	return $patches[0];
 }
 
-# Apply the given patch file to the given subdirectory.
-sub Patch { my ($patchfile,$subdir)=@_;
-	Status("Patching in $patchfile");
-	chdir $subdir;
-	# cd .. here in case the patchfile's name was a relative path.
-	# The -f passed to zcat makes it pass uncompressed files through
-	# without error.
-	SafeSystem("(cd ..;zcat -f $patchfile) | patch -p1","Patch error.\n");
-	# look for .rej files
-	if (`find . -name "*.rej"`) {
-		Error("Patch failed: giving up.");
-	}
-	SafeSystem('find . -name \'*.orig\' -exec rm {} \\;',"Error removing .orig files");
-	chdir "..";
-}
-
-# Returns the 822-date.
-sub GetDate {
-	my $date=`822-date`;
-	chomp $date;
-	if (!$date) {
-		Error("822-date did not return a valid result.\n");
-	}
-
-	return $date;
-}
-
-# Returns a email address for the current user.
-sub GetEmail {
-	if (!$ENV{EMAIL}) {
-		my $login = getlogin || (getpwuid($<))[0] || $ENV{USER};
-		open (MAILNAME,"</etc/mailname");
-		my $mailname=<MAILNAME>;
-		chomp $mailname;
-		close MAILNAME;
-		if (!$mailname) {
-			$mailname=`hostname -f`;
-			chomp $mailname;
-		}
-		return "$login\@$mailname";
-	}
-	else {
-		return $ENV{EMAIL};
-	}
-}
-
-# Returns the user name of the user who is running this.
-sub GetUserName {
-	my $username;
-	my $username_in_passwd=undef;	
-
-	my $login = getlogin || (getpwuid($<))[0] || $ENV{USER};
-
-	open (PASSWD,"</etc/passwd");
-	while (<PASSWD>) {
-		my (@fields)=split(/:/,$_);
-		if ($fields[0] eq $login) {
-			$username=$fields[4];
-			$username_in_passwd=1; # don't try NIS, no matter what.
-			close PASSWD;
-		}
-	}
-	close PASSWD;
-
-	if (!$username_in_passwd && !$username && -x "/usr/bin/ypmatch") {
-		# Give NIS a try.
-		open (YPMATCH,"ypmatch $login passwd.byname |");
-		my (@fields)=split(/:/,<YPMATCH>);
-		$username=$fields[4];
-		close YPMATCH;
-	}
-
-	# Remove GECOS(?) fields from username.
-	$username=~s/,.*//g;
-
-	# The ultimate fallback.
-	if (!$username) {
-		$username=$login;
-	}
-
-	return $username;
-}
-
-# Fill out a template, and save it to the passed location.
-# The hash that is passed to this function lists the tags that can be onthe
-# template, and the values to fill in for those tags.
-sub FillOutTemplate { my ($fn,$destfn,%fields)=@_;
-	open (IN,"<$fn") || Error("$fn: $!");
-	open (OUT,">$destfn") || Error("$destfn: $!");
-	while (<IN>) {
-		s/#(.*?)#/$fields{$1}/g;
-		print OUT $_;
-	}
-	close OUT;
-	close IN;
-}
-
 1