Script for extracting archives. Detects archive type, creates directories if needed.

extract

#!/usr/bin/perl

# Copyright (c) 2010, Ilya Strukov ([email protected])
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#     * Redistributions of source code must retain the above copyright
#       notice, this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#     * The name of the author nor the may not be used to endorse or promote products
#       derived from this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL COPYRIGHT HOLDER BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# This script automatically detects archive type by file's extension and extracts
# archive content. If there are several files in the archive and they are not
# placed in a directory, script automatically creates directory for this files
# before extracting. In case of directory name collision the scripts gives new
# directories names like dirname_1, dirname_2 etc.

use Cwd 'abs_path';
use strict;
use warnings;

my %magic = ( '\.tar'      => 'tar -xvf',
	      '\.tar\.gz'  => 'tar -xzvf',
	      '\.tgz'      => 'tar -xzvf',
	      '\.gz'       => 'gunzip',
	      '\.tar\.bz2' => 'tar -xjvf',
              '\.zip'      => 'unzip',
              '\.rar'      => 'rar x',
	      '\.7z'       => '7z x'
);

# check file for existance; generate new name if such file's already exists
sub new_name {
    my ($file) = @_;
    if (-e $file) {
	my $i;
	$i = 1;
	(++$i) while -e "$file\_$i";
	$file = "$file\_$i";
    }
    return $file;
}

sub file_info {
    my ($file) = @_;
    my ($cmd,$basename,$shortname) = ('','','');

    foreach my $ex (keys %magic) {
	if ($file =~ /(([^\/]*)$ex)$/i) {
	    $cmd = "$magic{$ex} " . abs_path($file);
	    $basename = $1;
	    $shortname = $2;
	    last;
	}
    }

    return ($cmd,$basename,$shortname);
}

sub extract_file {
    my ($file) = @_;
    my $level = 0;
    my ($cmd,$basename,$shortname);
 
    while (1) {
	($cmd,$basename,$shortname) = &file_info($file);
	unless ($cmd) {
	    die "File '$file' has unknow archive format" if $level == 0;
	    last;
	}

	my $tmpdir = &new_name(".extract_$basename");

	(mkdir $tmpdir) or die "Cannot create temporary directory '$tmpdir'";
	chdir $tmpdir;

	print "Executing '$cmd'";
	system $cmd;
	die "Child process exited abnormally" if $?;
	
	chdir '..';

	my $result = "";
	my @files = split(/\n/, `ls $tmpdir`);
	if (scalar(@files) == 1) {
	    #if there was only one file in the archive, just move it to the destination directory
	    $result = &new_name($files[0]);
	    (rename "$tmpdir/$files[0]", $result) or die "Cannot rename file '$tmpdir/$files[0]' to '$result'";
	    (rmdir $tmpdir) or die "Cannot remove temporary directory '$tmpdir'";
	} else {
	    #if we have several files, rename temporary directory according to archive's name
	    $result = &new_name($shortname);
	    (rename $tmpdir, $result) or die "Cannot rename temporary directory '$tmpdir' to '$result'";
	}

	print "Archive '$file' was extracted to '$result'\n";
	unlink $file if $level++ > 0;

	if (-f $result) {
	    $file = $result;
	} else {
	    last;
	}
    }
}

die "Usage: extract file" unless scalar(@ARGV) > 0;
foreach my $param (@ARGV) {
    #TODO: process arguments
    &extract_file($param);
}