#!/usr/bin/perl

# archery v0.2.1
# 2006.07.21
# pturing@firehead.org
#
# Put it in your ~/bin and chmod +x it 
#
# Usage:
# archery YOURFILEHERE


package Archery;

=head1 NAME

  archery.pl - A script for extracting archives

=head1 SYNOPSIS

Have you ever extracted an archive only to discover that it has spewed files all over your current directory like so much bukkake?
Do you try to work around this by listing the files first, or making temporary directories into which to extract the files?
Do you then have to deal with the useless 'extract', 'CRAP', 'foo', 'fnord', or 'New Folder' directories sitting around?
Are you annoyed that getting the occassional file from a teamkilling computard who doesn't know how to pack an archive means you have to use protection every time?
If so (and you run Linux or similar) maybe archery is for you.


=head1 DESCRIPTION

Archery goes through the whole process of extraction for you. It will:

    * Determine the program needed to extract the archive
    * Create a temporary directory
    * Extract the archive there
    * Rename the temporary directory to the base name of the archive if it was packed by a moron
    * Move the single file or directory out of the temporary space if it wasn't
    * Clean up after itself, so you don't have to move or delete useless directories
    * Immanentize the Eschaton
    * Inform you of the name of the single resulting file or directory, and its type


=head1 LICENSE

Copyright (c) 2007 Josh Jackson <pturing@firehead.org>

Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
files (the "Software"), to deal in the Software without
restriction, including without limitation the rights to use,
copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following
conditions:

The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.

=cut




use strict;
use Cwd;
use Cwd 'abs_path';
use Switch;
use File::Basename;
use File::Spec;
use File::Temp qw/ tempdir /;


if ($#ARGV == -1 or $ARGV[0] =~ /-help/) {
  print "usage: ";
  print basename $0 . " ARCHIVE_FILE\n";
  print "If you have the necessary extract program installed, it should work for\n";
  print "7-zip, CAB (Micro\$soft and installshield), CPIO, LHa, ACE, RAR, ARJ, and TAR files\n";
  print "See http://pturing.firehead.org/software/archery/recommended_support_programs.txt \n";
  print "for suggested programs to install for each file format\n\n";
  exit;
}


my $file = $ARGV[0];
my $basename = basename($file);
my $fullpath = abs_path($file);
my $orig_dir = getcwd();
my $type = `file -b \"$file\"`;
my ($in, $out) = '';



#determine a command to extract the file. exit if we can't figure one out
sub extract_command {
  my($type) = $_[0];
  my($test) = '';
  switch($type) {
    case /^Zip/ {
      $test = `unzip -v`;
      if ($test =~ /UnZip/) {
        return 'unzip';
      }
    }
    case /Microsoft Cabinet archive/ {
      $test = `cabextract --version`;
      if ($test =~ /cabextract/) {
        return 'cabextract';
      }      
    }
    case /7-zip archive/ {
      $test = `7z | head -n 2 | tail -n 1`;
      if ($test =~ /7-Zip/) {
        return '7z x';
      }      
    }
    case /InstallShield CAB/ {
      $test = `unshield -V`;
      if ($test =~ /Unshield/) {
        return 'unshield x';
      }      
    }
    case /cpio/ {
      $test = `cpio --version`;
      if ($test =~ /cpio/) {
        return 'cpio -iv <';
      }      
    }
    case /^LHa/ {
      #My copy of lha outputs its version and help info to stderr
      $test = `lha --version 2>&1`;
      if ($test =~ /LHa/) {
        return 'lha x';
      }
    }
    case /^ARJ/ {
      $test = `unarj`;
      if ($test =~ /UNARJ/) {
        return 'unarj x';
      }      
    }
    case /^ACE/ {
      #Try for the non-free unace first
      $test = `/opt/bin/unace | head -n 2 | tail -n 1`;
      if ($test =~ /UNACE/) {
        return '/opt/bin/unace x';
      }
      $test = `unace`;
      if ($test =~ /UNACE/) {
        return 'unace x';
      }      
      $test = `unace-free`;
      if ($test =~ /UNACE/) {
        return 'unace-free x';
      }
    }
    case /^RAR/ {
      #My copy of unrar prints a blank line first
      $test = `unrar --help | head -n 2 | tail -n 1`;
      if ($test =~ /UNRAR/) {
        return 'unrar x';
      }
      #Maybe someone else has a sane copy that doesn't
      $test = `unrar --help`;
      if ($test =~ /UNRAR/) {
        return 'unrar x';
      }      
      $test = `rar --help | head -n 2 | tail -n 1`;
      if ($test =~ /RAR/) {
        return 'rar x';
      }      
      $test = `rar --help`;
      if ($test =~ /RAR/) {
        return 'rar x';
      }      
    }
    # Really I should use recursion on this function when encountering .bz2 or .gz files
    # and I should test for the presence of tar
    # but anyone that doesn't have tar or is dealing with a .zip.bz2 file is clearly insane
    case /^bzip2 compressed data/ {
      return 'tar xjf';
    }
    case /^gzip compressed data/ {
      return 'tar xzf';
    }
    case /tar archive/ {
      return 'tar xf';
    }
    else {
      print "type not supported - $type\n";
      exit;
    }
  }
  print "No program found for type $type\n";
  exit;
}



#FIXME: print extract command output on failure
#extract the archive to a temporary directory
my($cmd) = extract_command($type) . " \"$fullpath\"";
my($tempdir) = tempdir('archery_XXXXXXX');
chdir($tempdir);
my($result) = `$cmd`;
chdir('..');
opendir(DIR, $tempdir);
my(@extracted) = readdir(DIR);
closedir DIR;

#this should be updated to keep trying to find a new name when the one we want is taken
if ($#extracted > 2) {
  $in = $tempdir;
  if (-e $basename) { $out = $basename."_extracted"; }
  else { $out = $basename; }
} 
else {
  $in = $tempdir."/".$extracted[2];
  if (-e $extracted[2]) {
    $out = $extracted[2] . "_extracted";
  } 
  else {
    $out = $extracted[2];
  }
}

`mv \"$in\" \"$out\"`;

my($out_type) = `file -b \"$out\"`;
chomp($out_type);
print "extracted to $out ($out_type)\n";
rmdir($tempdir);