#!/usr/bin/perl -w

######################################################################
###
###   IMPORTANT!
###   Please read the warranty and legal notice 
###   at the end of this file!
###
######################################################################

require 5.000;
use lib '/usr/local/bin',"$ENV{HOME}/bin",'/usr/stud/loescher/bin';
use lib 'd:/bin','c:/mydos','c:/bin','l:/usr/local/bin';
use slutil 2005.0118;
use English;
use File::Basename;

##############################################################################
### Voreinstellungen
##############################################################################

$version = '3.39';
$appname = 'AREX - Automatisches Auspacken';

$Pager = findpager();

##############################################################################
### Programmeinstellungen
##############################################################################

$MeinName = $0;
$MeinName =~ s/.*[\/\\]([^\/\\]+)/$1/;

##############################################################################
### Hauptprogramm
##############################################################################

&Hilfe if ($#ARGV<0);

# Pfade definieren
unless (defined $ENV{"AREX_ARCHIV_PFAD"}) 
{
  die "Bitte definieren Sie im Environment AREX_ARCHIV_PFAD, um damit ".
  "festzulegen, wohin die Original-Archive kopiert werden sollen!\n";
}
$arverz = $ENV{"AREX_ARCHIV_PFAD"};

# Optionen einlesen
$saveorig     = undef;
$secure       = $FALSE;
$createSubdir = $TRUE;
while ( $ARGV[0] =~ /^-/ )
{
 OPTION:
  {
    if ($ARGV[0] eq "-saveorig")
    {
      $saveorig = $TRUE;
      shift @ARGV; last OPTION
    }
    if ($ARGV[0] eq "-notsaveorig")
    {
      $saveorig = $FALSE;
      shift @ARGV; last OPTION
    }
    if ($ARGV[0] eq "-secure")
    {
      $secure = $TRUE;
      shift @ARGV; last OPTION
    }
    if ($ARGV[0] eq "-nosub")
    {
      $createSubdir = $FALSE;
      shift @ARGV; last OPTION
    }

    # Sonst:
    die "Option $ARGV[0] gibt es nicht!\n";
  }
}

&List(@ARGV) if ($MeinName eq "list");

printumlaute Kopf();

&Auspacken(@ARGV);


##############################################################################
### Unterprogramme
##############################################################################

sub Auspacken
{
  my @files = @_;
  my $startpfad;
  chomp($startpfad = `pwd`);

  foreach $file (@files)
  {
    chdir $startpfad;
    unless ( -e $file )
    {
      warn "File '$file' nicht vorhanden!\n";
      next;
    }
    my $ohneendung;
    my $path = "";
    my $endung;
    my $input;
    ($ohneendung,$path,$endung) = fileparse($file,packer(),'exe');
    if ( ($endung eq "") || !-e $file )
    {
      warn "File '$file' hat unbekannten Typ!\n";
      next;
    }

    # *.exe-Files gesondert betrachten
    $WirklicheEndung = $endung;
    if ($endung eq 'exe')
    {
      $WirklicheEndung = GetSelfExtractorType($file);
      if (!defined $WirklicheEndung)
      {
	warn "File '$file' ist kein bekannter SFX!\n";
	next;
      }
      print "Das File ist ein SFX und tatsächlich ein '$WirklicheEndung'\n";
    }

    print "Bearbeite $file ...\n";

    $ohneendung =~ s/\.$//;

    if ($createSubdir)
    {
      # Testen, ob Archiv ein Hauptverzeichnis mit eingepackt hat
      $ArchivMitPfaden = HatArchivPfade($file,$WirklicheEndung);
      print "*** Archiv hat ", $ArchivMitPfaden ? "": "KEINE ", "Pfade!\n";
      if ($secure)
      {
	print "*** Stimmt das wirklich? (JA = j/y/1) ";
	$input = readkey(); print "\n";
	$ArchivMitPfaden = ! $ArchivMitPfaden unless ("\L$input\E" =~ /[jy1]/);
	print "*** Archiv hat ", $ArchivMitPfaden ? "": "KEINE ", "Pfade!\n";
      }
    }
    else
    {
      $ArchivMitPfaden = $TRUE;
    }

    # Kopieren (Aufheben)?
    $aufgehoben = $FALSE;
    unless (defined $saveorig)
    {
      print "*** Soll das File nach $arverz kopiert werden? (JA = j/y/1) ";
      $input = readkey(); print "\n";
    }
    else
    {
      $input = 'n';
      $input = 'j' if $saveorig;
    }
    if ("\L$input\E" =~ /[jy1]/)
    {
      FileCopySecure($file, "$arverz$slash$file", $FCS_COPY, $FCS_PRINT);
      $aufgehoben = $TRUE;
    }
    else # Falsche Eingaben
    {
      unless ("\L$input\E" =~ /n/)
      {
	die "Bitte nur mit 'j','y','1' oder 'n' antworten.\n";
      }
    }

    if ( ! $ArchivMitPfaden)
    {
      # Verzeichnis anlegen
      my $ok = mkdir $ohneendung,0755;
      unless ($ok) # Das könnte man noch verfeinern...
      { die "Kann Verzeichnis '$ohneendung' nicht anlegen!\n" }

      # Ins Zielverzeichnis verschieben
      FileCopySecure($file, "$ohneendung$slash$file", $FCS_MOVE, $FCS_PRINT);

      chdir $ohneendung;
    }

    # Auspacken
    system( packer($file,$WirklicheEndung,"EXTR") );
    # Wenn nur das Archivfile rumliegt, dann ist etwas schiefgelaufen
    @ausgepackteFiles = glob("*");
    if ($#ausgepackteFiles == 0)
    {
      print "*** Es konnte nicht ausgepackt werden!\n";
      exit;
    }
    else
    {
      unlink $file;
    }
    undef @ausgepackteFiles;

    # Testen, ob beim Auspacken nur ein File entstanden ist und sonst nichts
    # In diesem Fall kann man das File eine Verzeichnis-Ebene höher kopieren
    my @files = glob("*");
    if ( ($#files == 0) && (-f $files[0]) )
    {
      FileCopySecure($files[0],'..'.$slash.$files[0], $FCS_MOVE, $FCS_PRINT);
      rmdir $ohneendung;
    }
  }
}


sub List
{
  my @files = @_;
  foreach $file (@files)
  {
    my $path = "";
    my ($ohneendung,$endung);
    ($ohneendung,$path,$endung) = fileparse($file,packer(),'exe');
    if ( $endung eq "" )
    {
      warn "File '$file' hat unbekannten Typ!\n";
      next;
    }

    # *.exe-Files gesondert betrachten
    $WirklicheEndung = $endung;
    if ($endung eq 'exe')
    {
      $WirklicheEndung = GetSelfExtractorType($file);
      if (!defined $WirklicheEndung)
      {
	warn "File '$file' ist kein bekannter SFX!\n";
	next;
      }
      print "Das File ist ein SFX und tatsächlich ein '$WirklicheEndung'\n";
    }

    system( packer($file,$WirklicheEndung,"LIST") . "| $Pager" );

    print "*** Wollen Sie das File jetzt mit AREX auspacken? (JA = j/y/1) ";
    my $input = readkey(); print "\n";
    &Auspacken($file) if ("\L$input\E" =~ /[jy1]/);
  }
  exit;
}


sub HatArchivPfade
{
  # Parameter: (File, Endung)
  # Stellt fest, ob ein Archiv Pfade mit eingepackt hat oder nicht.
  # Return: True oder False
  # Beispiel:
  #
  # Hier kann man sich sparen, ein Hauptverzeichnis anzulegen:
  # drwxr-xr-x root/root         0 Mar 11 05:55 1997 type1inst-0.5b/
  # -rwxr-xr-x root/root     35042 Mar 11 05:55 1997 type1inst-0.5b/type1inst
  # -rw-r--r-- root/root     19026 Mar 11 05:55 1997 type1inst-0.5b/README
  # -rw-r--r-- root/root     17982 Mar 11 05:55 1997 type1inst-0.5b/COPYING
  #
  # Hier sollte man schon ein Verzeichnis anlegen:
  # -rwxr-xr-x root/root     35042 Mar 11 05:55 1997 type1inst
  # -rw-r--r-- root/root     19026 Mar 11 05:55 1997 README
  # -rw-r--r-- root/root     17982 Mar 11 05:55 1997 COPYING
  #
  my $pfad;
  my ($file,$endung) = @_;
  my $fh = FileHandle->new();
  open($fh, packer($file,$endung,"LIST") . " |") || die "List geht nicht!\n";
  my @liste = <$fh>;
  close $fh;

  # Tar-Files (Nur GNU-Tar!)
  if (
      ($endung eq "tar")     ||
      ($endung eq "tgz")     ||
      ($endung eq "tar.gz")  ||
      ($endung eq "tar.z")   ||
      ($endung eq "tar.bz2") ||
      ($endung eq "tbz2")    ||
      ($endung eq "tbz")
     )
  {
    print "Analyse von:\n";
    print @liste[0..min(2,$#liste)];;
    print "...\n";
    # Test auf sowas:
    # drwxr-xr-x root/root 0 Mar 11 05:55 1997 type1inst-0.5b/
    return $FALSE unless $liste[0] =~ /^.*(\s.*?\/)$/;
    $pfad = $1;

    # Jetzt müssen alle anderen Zeilen auch diesen Pfad enthalten
    print "PFAD: '$pfad'\n";
    return ( grep(/\Q$pfad\E/o,@liste)-1 == $#liste );
  }

  return $FALSE;
}


sub Kopf
{
  my $head = "$appname $version   -   von Stephan Löscher";
  return "\n$head\n" . '~' x length($head) . "\n";
}


sub Hilfe
{
  printumlautepaged
  Kopf().
"Syntax:   arex [optionen] archivfiles
Beispiel: arex *.zip

Das Archivfile wird nach Rückfrage nach \$AREX_ARCHIV_PFAD kopiert.
(Die Rückfrage kann mit -saveorig und -notsaveorig unterdrückt werden.)
Dann wird ein Unter-Verzeichnis im aktuellen Verzeichnis erstellt
und dort das Archivfile ausgepackt.
Das Unterverzeichnis wird nicht erstellt, wenn im Archiv selbst schon ein
Unterverzeichnis enthalten ist.
Wenn beim Auspacken nur ein File entsteht, dann wird es wieder eine
Verzeichnisebene nach oben kopiert.
Unterstützte Formate:\n",join(", ",packer()),"
(Sowie selbstextrahierende Formate (SFX) mit Endung .exe)

Wenn AREX als 'list' aufgerufen wird, dann wird das Archiv nur gelistet.

Optionen:
-saveorig    : File wird nach \$AREX_ARCHIV_PFAD kopiert.
-notsaveorig : File wird NICHT nach \$AREX_ARCHIV_PFAD kopiert.
-secure      : Zusätzliche Fragen an den Benutzer (Empfehlenswert, wenn man
	       arex auf einer neuen Plattform einsetzt.)
-nosub       : Beim Auspacken soll KEIN Unterverzeichnis angelegt werden.
";
exit;
}


######################################################################
#
# Warranty and legal notice
# ~~~~~~~~~~~~~~~~~~~~~~~~~
#
# Copyright (c) 1997 by Stephan Löscher  -  all rights reserved
# My Address: Stephan Löscher, Dr.Troll-str. 3, 82194 Gröbenzell, Germany
# Email: loescher@gmx.de
# WWW: http://www.loescher-online.de/
#
# This program is freeware.
# It is NOT Public-Domain-Software!
# The author (Stephan Löscher) does NOT give up his copyright, but he 
# reserves his copyright. Usage and copying is free of charge for private
# use, but NOT for commercial use!
#
# You may and should copy this program free of charge, use it,
# give it to your friends, upload it to a BBS or something similar, under
# the following conditions:
# * Don't charge any money for it. If you upload it to a BBS, make sure that
#    it can be downloaded free (without paying for downloading it, except
#    for usage fees that have to be paid anyway). Small copying fees (up to
#    5 DM or 3 $US) may be charged.
#  * Only distribute the whole original package, with all the files included.
#  * This program may not be part of any commercial product or service without
#    the written permission by the author.
#  * If you want to include this program on a CD-ROM and/or book, please send
#    me a free copy of the CD/book (this is not a must, but I would appreciate
#    it very much).
#
# Distribution of the program is explicitly desired, provided that the above
# conditions are accepted.
#
# YOU ARE USING THIS PROGRAM AT YOUR OWN RISK! THE AUTHOR (STEPHAN LÖSCHER)
# IS NOT LIABLE FOR ANY DAMAGE OR DATA-LOSS CAUSED BY THE USE OF THIS PROGRAM
# OR BY THE INABILITY TO USE THIS PROGRAM. IF YOU ARE NOT SURE ABOUT THIS, OR
# IF YOU DON'T ACCEPT THIS, THEN DO NOT USE THIS PROGRAM!
# BECAUSE OF THE VARIOUS HARDWARE AND SOFTWARE ENVIRONMENTS INTO WHICH THIS
# PROGRAM MAY BE PUT, NO WARRANTY OF FITNESS FOR A PARTICULAR PURPOSE IS
# OFFERED.
# GOOD DATA PROCESSING PROCEDURE DICTATES THAT ANY PROGRAM BE THOROUGHLY
# TESTED WITH NON-CRITICAL DATA BEFORE RELYING ON IT.
#
# No part of the documentation may be reproduced, transmitted, transcribed,
# stored in any retrieval system, or translated into any other language in
# whole or in part, in any form or by any means, whether it be electronic,
# mechanical, magnetic, optical, manual or otherwise, without prior written
# consent of the author, Stephan Löscher.
#
# You may not make any changes or modifications to this software or this
# manual. You may not decompile, disassemble, or otherwise reverse-engineer
# the software in any way.
# If you got the source, then you are permitted to modify it if you
# contact me and tell me your enhancements.
# You also may include the source as a whole or parts of it into other
# programs, as long as you don't make profit directly out of selling
# the result. If you re-use code of this program then do not remove my name!
# If you include this source-code in your projects, mark it clearly as such
# "... derived from code XXX by Stephan Löscher".
# But don't distribute modified code!
#
# If you believe your copy of this software has been tampered or altered in
# anyway, shape or form, please contact me immediately! Do not hesitate a
# moment to inform me. Remember, this software should be available to all, in
# the original form, so please do not accept modified or damaged versions of
# my software.
#
# The author reserves his right for taking legal steps if the copyright or the
# license agreement is violated.
#
# All product names mentioned in this software are trademarks or registered
# trademarks of their respective owners.
#
# If you have any questions, ideas, suggestions for improvements or if you find
# bugs (I don't hope so.) then feel free to contact me. (Email is appreciated.)
#
# I'm not a native english speaker. If you are one and discover some strange
# sounding parts in this documentation or in the program, please, feel free
# to point it out to me and give me suggestions for alteration!
#
# If the program works for you, and you want to honour my efforts, you are
# invited to donate as much as you want... :)
#
# In any case, if you don't like the restrictions in this license, contact
# me, and we can work something out.
#
######################################################################