spill

#!/usr/bin/perl
# 2010 (c) Przemysław Iskra <sparky@pld-linux.org>
#
# extract files from .rar, .zip and .001 files

use strict;
use warnings;
use Carp;

my %opts;

sub red
{
	print "\033[1;31m", @_, "\033[0;37m\n";
}

sub green
{
	print "\033[1;32m", @_, "\033[0;37m\n";
}

sub blue
{
	print "\033[1;34m", @_, "\033[0;37m\n";
}

sub cmd2lines
{
	my @cmd = @_;
	my @lines;

	green( "@cmd" );

	open IN, "-|", @cmd
		or croak "Cannot run command @cmd";
	while ( <IN> ) {
		push @lines, $_;
		print $_;
	}
	close IN
		or croak "Command @cmd failed";

	return @lines;
}

sub clean
{
	return unless exists $opts{c};
	red( "rm @_" );
	unlink @_;
}

# unrar {{{
sub unrar
{
	my $file = shift;

	my @exfiles = map { /^Extracting from (.*?)\s*$/ }
		cmd2lines( "unrar", "-idp",
			($opts{p} ? "-p$opts{p}" : ()),
			"x", $file );

	blue "File(s) @exfiles extracted.";
	clean @exfiles;
}
# }}}

# unzip {{{
sub unzip_makedir
{
	local $_ = shift;
	s{^.*/}{};
	s{\.zip$}{}i;
	mkdir $_;
	return ("-d", $_);
}

sub unzip_maybedir
{
	my $file = shift;
	my @f = cmd2lines( "unzip", "-l", $file );
	if ( $f[ $#f ] =~ /\s+1 file/ ) {
		return ();
	}

	do {
		return () unless @f;
		$_ = shift @f;
	} until ( /^-+/s );

	$_ = shift @f;
	m{^.*?:\d+\s+(.*?)/};
	my $dir = $1;
	return unzip_makedir( $file ) unless defined $dir;
	while ( $_ = shift @f ) {
		last unless /^.*?:\d+\s+(.*)$/;
		$_ = $1;
		m#(.*?)/#;
		if ( not defined $1 or $dir ne $1 ) {
			return unzip_makedir( $file );
		}
	}

	return ();
}

sub unzip
{
	my $file = shift;

	my @opts;
	push @opts, unzip_maybedir( $file );

	my @exfiles = map { /^Archive:\s+(.*?)\s*$/ }
		cmd2lines( "unzip", @opts, $file );

	blue "File(s) @exfiles extracted.";
	clean @exfiles;
}
# }}}

# unsplit {{{
sub fsize
{
	return (stat shift)[7];
}

sub unsplit
{
	my $file = shift;
	my $fs = fsize $file;

	( my $base = $file ) =~ s/\.001//;
	my @files = sort glob "$base.[0-9][0-9][0-9]";

	# starts at .000 ?
	croak "Invalid file $files[0]"
		unless $files[0] eq $file;

	my $last_file = pop @files;

	# at least 2 files
	croak "Not enough files"
		unless scalar @files >= 1;

	# number of files must be the same as number in last file
	$last_file =~ /\.([0-9]{3})$/;
	croak "Some file is missing"
		unless $1 == 1 + scalar @files;

	# last file must be smaller
	croak "Cannot find last file"
		if $fs <= fsize $last_file;

	foreach my $f ( @files ) {
		# all other files must have same size
		croak "File $f has wrong size"
			unless $fs == fsize $f;
	}

	push @files, $last_file;

	$base =~ s#.*/##;
	green( "cat @files > $base" );

	open F_OUT, ">", $base
		or return;

	my $len = 16 * 1024 * 1024;
	my $buf = " " x $len;
	$buf = "";
	foreach my $f ( @files ) {
		open F_IN, "<", $f
			or return;
		while ( read F_IN, $buf, $len ) {
			print F_OUT $buf
				or return;
		}
		close F_IN;
	}

	close F_OUT
		or return;

	blue "Files @files extracted.";
	clean @files;
}
# }}}

sub spill
{
	my $file = shift;
	if ( $file =~ /\.rar$/i ) {
		unrar( $file );
	} elsif ( $file =~ /\.zip$/i ) {
		unzip( $file );
	} elsif ( $file =~ /\.001$/ ) {
		unsplit( $file );
	} else {
		print "Skipping $file\n";
	}
}

croak "spill [-c] [-pPASSWORD] <files>\n"
	unless @ARGV;

while ( $ARGV[0] =~ /^-(\S)(.*)?/ ) {
	shift @ARGV;
	last if $1 eq "-";
	$opts{ $1 } = $2;
}

my @files = sort @ARGV;
while ( my $file = shift @files ) {
	next unless -r $file;
	eval {
		spill( $file );
	};
}

# vim: fdm=marker