bloat

Bloat is a basic Perl script to allow you to easily decompress files from many formats.

$strings{nl}{cantcloseconfig} = qq/Kan configuratiebestand niet sluiten: /;
$strings{nl}{versioninfo} = <<VERINFO;
${bloatsign}bloat versie $version, vrijgegeven onder de GPL v. 2 of nieuwer, naar keuze.
${bloatsign}Bloat's website is <http://bloat.sourceforge.net/>.
${bloatsign}Copyright (c)2002-2005 Dave Wickham <dave\@allaboutgames.co.uk>.
VERINFO
$strings{nl}{invalidopt} = sub { return qq/${bloatsign}$_[0] wordt niet als optie herkend.\n/ };
$strings{nl}{checkingarchive} = qq/${bloatsign}Bezig archief te controleren... dit kan even duren (uitschakelen met -nc).\n/;
$strings{nl}{custcmdnewdirextract} = sub { return qq!${bloatsign}$_[2]: $_[0] bestand - bezig met uitpakken met een aangepast commando naar "./$_[1]/".\n! };
$strings{nl}{newdirextract} = sub { return qq!${bloatsign}$_[3]: $_[0] bestand - bezig met uitpakken met "$_[2]" naar "./$_[1]/".\n! };
$strings{nl}{custcmdextract} = sub { return qq!${bloatsign}$_[1]: $_[0] bestand - bezig met uitpakken met een aangepast commando.\n! };
$strings{nl}{extract} = sub { return qq!${bloatsign}$_[2]: $_[0] bestand - bezig met uitpakken met "$_[1]".\n! };
$strings{nl}{cmdnotfound} = sub { return qq/${bloatsign}*WAARSCHUWING* - $_[0] kan niet worden gevonden.\n/ };
$strings{nl}{cmdlocdontknow} = sub { return qq/${bloatsign}Ik heb geen idee waar ik $_[0] kan vinden.\n/ };
$strings{nl}{cmdloc} = sub { return qq/${bloatsign}Je vind $_[0] op <$_[1]>.\n/ };
$strings{nl}{error} = qq/
${bloatsign}Oeps, er is een fout opgetreden. Waarschijnlijk wordt het
${bloatsign}bestandsformaat niet ondersteund of de extensie is niet standaard
%{bloatsign}(zoals een gzip bestand met een bz2 extensie).
${bloatsign}Als je ZEKER weet dat dit een geldig archief is, e-mail dan naar
${bloatsign}<dave\@allaboutgames.co.uk> met onderstaande regels:\n/;
$strings{nl}{allutils} = qq/${bloatsign}Alle programma's zijn gevonden!\n/;

## SE, thanks to ScareyedHawk
$strings{se}{nofile} = qq/${bloatsign}Ingen fil n盲mnd.\n/;
$strings{se}{noexist} = sub { return qq/${bloatsign}"$_[0]" existerar inte.\n/ };
$strings{se}{help} = <<HELPEND,
${bloatsign}bloat version $version - Anv盲ndnings intsruktioner:
${bloatsign}Skriv helt enkelt "bloat <filnamn>" - bloat kommer automatiskt 
${bloatsign}v盲lja programmen som ska anv盲ndas.
${bloatsign}Dom f枚ljande valen 盲r ocks氓 tillg盲ngliga:
${bloatsign}         --check          S枚k efter n枚dv盲ndiga "utilities".
${bloatsign}    -c   --checksubdir    Till氓t undermapps checkning med tar-, 
${bloatsign}                          ace- och zip-baserade arkiv.
${bloatsign}    -nc  --nochecksubdir  Till氓t ej undermapps checkning med tar-,
${bloatsign}                          ace- och zip-baserade arkiv.
${bloatsign}         --verbose        Visa allting som man skulle kunna se fr氓n
${bloatsign}                          "manuell extraktion".
${bloatsign}         --version        Visar bloat's version och licens info.
HELPEND
$strings{se}{cantcloseconfig} = qq/Kan inte st盲nga konfigurations-filen: /;
$strings{se}{configerror} = sub { return <<CONFIGERROREND
${bloatsign}"$_[0]" valet 盲r felints盲llt i konfigurationsfilen.
${bloatsign}Val 盲r varken s盲tt till sant eller falskt; anv盲nder standardv盲rde.
CONFIGERROREND
};
$strings{se}{cantopenconfig} = qq/Kan inte 枚ppna konfigurations-filen: /;
$strings{se}{versioninfo} = qq/${bloatsign}Bloat version $version, sl盲ppt under GPL v. 2 eller senare, v盲lj sj盲lv.
${bloatsign}Bloat's hemsida finns p氓 <http:\/\/bloat.sourceforge.net\/>.
${bloatsign}Copyright (c)2002-2005 Dave Wickham <dave\@allaboutgames.co.uk>.\n/;
$strings{se}{invalidopt} = sub { return qq/${bloatsign}$_[0] 脛r inte ett igenk盲nt val.\n/ };
$strings{se}{checkingarchive} = qq/${bloatsign}Kollar arkiv... Detta kan ta ett tag (St盲nd av med -nc).\n/;
$strings{se}{custcmdnewdirextract} = sub { return qq!${bloatsign}$_[1]: $_[0] fil - Anv盲nder "$_[2]" f枚r att extrakta till "./$_[1]/".\n! };
$strings{se}{newdirextract} = sub { return qq!${bloatsign}$_[3]: $_[0] fil - Anv盲nder "$_[2]" f枚r att extrakta till "./$_[1]/".\n! };
$strings{se}{custcmdextract} = sub { return qq/${bloatsign}$_[1]: $_[0] fil - Anv盲nder egna kommandon f枚r att extrakta.\n/ };
$strings{se}{extract} = sub { return qq/${bloatsign}$_[2]: $_[0] fil - Anv盲nder "$_[1]" f枚r att extrakta.\n/ };
$strings{se}{cmdnotfound} = sub { return qq/${bloatsign}*VARNING* $_[0] kunde inte hittas.\n/ };
$strings{se}{cmdlocdontknow} = sub { return qq/${bloatsign}Jag har ingen aning om var man hittar $_[0].\n/ };
$strings{se}{cmdloc} = sub { return qq/${bloatsign}Hittade $_[0] vid <$_[1]>.\n/ };
$strings{se}{error} = qq/${bloatsign}Uh-oh, ett fel har intr盲ffat. F枚rmodligen s氓 盲r inte filformatet st枚tt
${bloatsign}eller s氓 盲r till盲gget inte standard (Allts氓 en gzip fil med bz2 till盲gg.)
${bloatsign}Om du VET att det h盲r 盲r ett giltigt arkiv, var god e-maila
${bloatsign}<dave\@allaboutgames.co.uk> med raderna under:\n/;
$strings{se}{allutils} = qq/${bloatsign}Alla utilities 盲r nuvarande!\n/;

##### DO SUBS #####
# OK, get the lang first :P
if ($ENV{LANG} =~ /^de/i) {
	$locale = "de";
} elsif ($ENV{LANG} =~ /^en/i) {
	$locale = "en";
} elsif ($ENV{LANG} =~ /^es/i) {
	$locale = "es";
} elsif ($ENV{LANG} =~ /^fi/i) {
	$locale = "fi";
} elsif ($ENV{LANG} =~ /^nl/i) {
	$locale = "nl";
} elsif ($ENV{LANG} =~ /^se/i) {
	$locale = "se";
} else {
	$locale = "en";	# Fall back on English.
}


if ((-e "$ENV{HOME}/.bloatrc") || (-e "/etc/bloatrc")) {
	&parseConfig;
} 

&checkForArgs;

if (!$stop && !$files[0][0]) {			# Has the user specified, e.g., --verbose and no filename?
	print STDERR $strings{$locale}{nofile};
	$stop = 1;
}

if (!$stop) {
	foreach my $filearray (@files) {
		if (!(-e "$filearray->[0]")) {			# Just a small sanity check first :)
			print STDERR $strings{$locale}{noexist}->($filearray->[0]);
			$stop = 1;
		}
	
		# Annoying Regexps Follow - there must be a CPAN module to do this automatically or something.
		# I bet I'll look back on this in a year or so and get really embarassed. Ah well...
		# To stop the shell borking:
		$filearray->[0] =~ s/\\/\\\\/sg;	# Replace "\" with "\\"
		$filearray->[0] =~ s/\(/\\\(/sg;	# Replace "(" with "\("
		$filearray->[0] =~ s/\)/\\\)/sg;	# Replace ")" with "\)"
		$filearray->[0] =~ s/ /\\ /sg;	# Replace " " with "\ "
		$filearray->[0] =~ s/\'/\\\'/sg;	# Replace "'" with "\'"
		$filearray->[0] =~ s/\"/\\\"/sg;	# Replace '"' with '\"'
		$filearray->[0] =~ s/\&/\\\&/sg;	# "&", "\&"...
	
		if (!$stop) {
			$type = &getFileType($filearray->[1]);	# WORKS
		}

		if (!$stop) {
			&getExtractor($type);
		}
	
		if (!$stop) {
			&runExtractor($filearray->[0],$type);
		}
	}
}

##### Subs below this point #####
sub parseConfig { # FIXME: This should probably be rewritten to be more efficient.
	my $configloc;
	if ( -e "$ENV{HOME}/.bloatrc") {
		$configloc = "$ENV{HOME}/.bloatrc";	# Local takes priority
	} else {
		$configloc = "/etc/bloatrc";
	}

	my $opencheck = open(CONFIG, $configloc);			# No, I'm not going to stoop to The Camel Book's level and write "open(SESAME[...]);
	die("$strings{$locale}{cantopenconfig} $!") unless ($opencheck);

	while (<CONFIG>) {
		my $confline = $_;
		chomp($confline);
		if ($confline !~ /^#/) {		# Disregard all comment-only lines
			$confline =~ s/ //sg;		# Chuck all whitespace
			$confline =~ s/(.+?)#.*/$1/sg;	# Remove all comments

			if ($confline =~ s/^dontprefixoutput=(.+?)/$1/i) {
				if ($confline eq "TRUE") {
					$bloatsign = "";
				} elsif ($confline ne "FALSE") {
					$conferror = "dontprefixoutput";
					print STDERR $strings{$locale}{configerror}->($conferror);
				}
			} elsif ($confline =~ s/^verbose=(.+?)/$1/i) {# Verbose. Yay.
				if ($confline eq "TRUE") {
					$verbose = 1;
				} elsif ($confline eq "FALSE") {
					$verbose = 0;
				} else {
					$conferror = "verbose";
					print STDERR $strings{$locale}{configerror}->($conferror);
				}
			} elsif ($confline =~ s/^nowarn=(.+?)/$1/i) {# Nowarn...
				if ($confline eq "TRUE") {
					$nowarn = 1;
				} elsif ($confline eq "FALSE") {
					$nowarn = 0;
				} else {
					$conferror = "nowarn";
					print STDERR $strings{$locale}{configerror}->($conferror);
				}
			} elsif ($confline =~ s/^checkforsubdirs=(.+?)/$1/i) {
				if ($confline eq "TRUE") {
					$checkforsubdirs = 1;
				} elsif ($confline eq "FALSE") {
					$checkforsubdirs = 0;
				} else {
					$conferror = "checkforsubdirs";
					print STDERR $strings{$locale}{configerror}->($conferror);
				}
			} elsif ($confline =~ s/^gofortar=(.+?)/$1/i) {
				if ($confline eq "TRUE") {
					$gofortar = 1;
				} elsif ($confline eq "FALSE") {
					$gofortar = 0;
				} else {
					$conferror = "gofortar";
					print STDERR $strings{$locale}{configerror}->($conferror);
				}
			} elsif ($confline =~ s/^lang=(.+?)/$1/i) {	# Language
				if ($confline =~ /^de/i) {
					$locale = "de";
				} elsif ($confline =~ /^en/i) {
					$locale = "en";
				} elsif ($confline =~ /^es/i) {
					$locale = "es";
				} elsif ($confline =~ /^fi/i) {
					$locale = "fi";
				} elsif ($confline =~ /^nl/i) {	
					$locale = "nl";
				} elsif ($confline =~ /^se/i) { 
					$locale = "se";
				}	
			} elsif ($confline =~ s/^location\.(.+)/$1/i) { # Locations
				$confline =~ /(.+)=(.+)/;
				$loc{$1} = "$2";
			}
		}
	}

	my $closecheck = close(CONFIG);					# Always tidy up!
	die("Can't close config file: $!") unless ($closecheck);
}

sub checkForArgs {
	if (!@ARGV) {
		print $strings{$locale}{help};
		$stop = 1;
	}

	foreach my $option (@ARGV) {
		if (!$stop) {	
			if (($option eq "--check") && (!$nooptions)) {		# Ahh...the old "--check" option again :)
				$check = 1;
				$filetype = "unset";	# Stop perl complaining about an unset $filetype when run with warnings.
				&getExtractor;
				$stop = 1;
				last;
			} elsif (($option eq "--dont-use-tar") && (!$nooptions)) {
				$gofortar = 0;
			} elsif (($option eq "--use-tar") && (!$nooptions)) {
				$gofortar = 1;
			} elsif ((($option eq "--dont-prefix") || ($option eq "-dp")) && (!$nooptions)) {
				$bloatsign = "";
			} elsif (($option eq "--help") && (!$nooptions)) {	# --help...yay
				print $strings{$locale}{help};
				$stop = "1";
				last;
			} elsif (($option eq "--version") && (!$nooptions)) {	# Mmm... version
				print $strings{$locale}{versioninfo};
				$stop = 1;
				last;
			} elsif ((($option eq "--nochecksubdir") || ($option eq "-nc")) && (!$nooptions)) {
				$checkforsubdirs = 0;
			} elsif ((($option eq "--checksubdir") || ($option eq "-c")) && (!$nooptions)) {
				$checkforsubdirs = 1;
			} elsif (($option eq "--verbose") && (!$nooptions)) {	# Show the extraction
				$verbose = 1;
			} elsif (($option eq "--install-linux-utils") && (!$nooptions)) {	# Install Linux utils
				$getutils = "linux";
				if (!-e "$ENV{HOME}/.bloat-utils/") {
					mkdir("$ENV{HOME}/.bloat-utils/");
				}
			} elsif (($option eq "--awards") && (!$nooptions)) {	# Yay. Awards.
				# No i18n/l10n for --awards.
				print <<AWARDS;
<PatamonKid> | "The Luigi30 stamp is the suckiest and most vile award 
             | a program can get. The stamp is a sign of that program 
             | does nothing good, will only bring you misfortune, and
             | you are better off without it."
             |
           * | Luigi30 puts the Luigi30 stamp on bloat

	-- From #Uplink, irc.uplinkcorp.net, 2003-09-28
AWARDS
				$stop = 1;
				last;
			} elsif (($option eq "--gzt") && (!$nooptions)) {
				# Laugh. It's funny.
				# Just got the idea after reading <http://bugs.gentoo.org/show_bug.cgi?id=51123> ;-). OK, the author of the GZT (who shall remain nameless, unless you look it up) did.
				# Don't have anything against Gentoo, honest :-P.
				system("wget -q -O- http://bloat.sourceforge.net/gzt | less -R");
				$stop = 1;
				last;
			} elsif (($option eq "--") && (!$nooptions)) {
				$nooptions = 1;
			} elsif (($option =~ /^-.*/) && (!$nooptions)) {
				print STDERR $strings{$locale}{invalidopt}->($option);
				$stop = 1;
				last;
			} else {
				my $filename = $option;
				if ($filename !~ /^\//) {
					$filename = "$ENV{PWD}/$filename";
				}
				push @files, [($filename, $option)];
			} 
		}
	}
}

sub installUtil {	# UNDOCUMENTED UNSUPPORTED UNEVERYTHINGED
	# &installUtil(URL, extractmethod, filename)
	my $url = $_[0];
	my $extract = $_[1];
	my $filenamedownload = $_[2];
	chdir("$ENV{HOME}/.bloat-utils/");
	system("wget $url --referer=http://bloat.sourceforge.net/uuif.php --user-agent=\"wget/bloat $version - see http://bloat.sourceforge.net/uuif.php\"");
	system("$extract $filenamedownload");
	chdir("$workingdir");
}

sub checkForSubdirs {
	my @input = @_;
	my $hasitgotstuffoutofsubdirs;					# Yeah, it's a stupid variable name. I know. I only have to type it a few times.
	my @listofstuff = `$input[0] $input[2]`;
	my $line;
	my $lastfile = 0;
	foreach $line (@listofstuff) {
		chomp($line);
		if ($input[1] eq "tarlike") {