#!/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';
use slutil;
use English;

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

$version = '1.0';

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

printumlaute "\nFileSort 1.1   -   von Stephan Löscher\n";
print          "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n";

&Hilfe if ($#ARGV<1);

$rootdir  = KillSlashAtEnd(shift);
$kommando = join(' ',@ARGV);

die "Verzeichnis '$rootdir existiert nicht!\n" unless (-d $rootdir);

@files = glob("*");

foreach $file (@files)
{
  next if -d $file; # Verzeichnisse überspringen
 NOCHMAL:
  system("$kommando $file");
  $ziel = Auswahl($rootdir);
  goto NOCHMAL if $ziel eq '';
  FileCopySecure("$file", "$ziel$slash$file", $FCS_MOVE, $FCS_PRINT) || 
  warn "Fehler beim Verschieben!\n";
  print "Weiter mit Taste...\n";
  readkey;
}


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

sub Auswahl
{
  # Parameter: Ausgangsverzeichnis
  # Es wird eine Auswahl der Unterverzeichnisse angeboten 
  # Return: Gewähltes Verzeichnis.
  # Bsp.: Auswahl("/d/mod/") ergibt "/d/mod/pop"
  #

  my $input = "";
  my $root = shift;

  # Wenn sowas: "/s/mod/dance/.", dann ins Hauptverzeichnis kopieren.
  return $1 if $root =~ /(.*?)\/\./;

  my @dirs = grep(-d, glob("$root$slash*"));
  @dirs = grep(s/^$root(.*)/$1/, @dirs); # In @dirs ist dann sowas: "/pop"

  # Es gibt nur ein Hauptverzeichnis
  if ($#dirs < 0)
  {
    print "Keine weiteren  Unterverzeichnisse. Verschiebe ins Hauptverzeichnis...\n";
    return $root;
  }

  unshift @dirs,"/.";

  print "\nAuswahl: ENTER=wiederholen, q=Quit oder:\n";

  # Darstellungen dreispaltig nebeneinander, weil es sonst nicht hinpaßt
  if ($#dirs > 40)
  {
    my $i = 0;
    my $ziel;
    my $teilung = int($#dirs / 3);
    for($i=0; $i<=$teilung; $i++)
    {
      $ziel  = substr($dirs[$i],1);
      $ziel .= " " x (20-length($ziel));
      print sprintf("%2d",$i) . " = " . $ziel;
      if (defined $dirs[$teilung+$i+1])
      {
	$ziel  = substr($dirs[$teilung+$i+1],1);
	$ziel .= " " x (20-length($ziel));
	print sprintf("%2d",$teilung+$i+1) . " = " . $ziel;
      }
      if (defined $dirs[$teilung+$teilung+$i+2])
      {
	$ziel  = substr($dirs[$teilung+$teilung+$i+2],1);
	$ziel .= " " x (20-length($ziel));
	print sprintf("%2d",$teilung+$teilung+$i+2) . " = " . $ziel;
      }
      print "\n";
    }
  }

  # Darstellungen zweispaltig nebeneinander, weil es sonst nicht hinpaßt
  elsif ($#dirs > 20)
  {
    my $i = 0;
    my $ziel;
    my $teilung = int($#dirs / 2);
    for($i=0; $i<=$teilung; $i++)
    {
      $ziel  = substr($dirs[$i],1);
      $ziel .= " " x (20-length($ziel));
      print sprintf("%2d",$i) . " = " . $ziel;
      if (defined $dirs[$teilung+$i+1])
      {
	$ziel  = substr($dirs[$teilung+$i+1],1);
	$ziel .= " " x (20-length($ziel));
	print sprintf("%2d",$teilung+$i+1) . " = " . $ziel;
      }
      print "\n";
    }
  }

  # Zeilenweise Darstellung
  else
  {
    my $i;
    for($i=0; $i<=$#dirs; $i++)
    {
      $ziel  = substr($dirs[$i],1);
      print sprintf("%2d",$i) . " = " . "$ziel\n";
    }
  }

  print "\n";
  chomp($input = <STDIN>);
  
  # Wiederholung
  return '' if $input eq '';
  
  # Ende
  exit if ( ($input eq "q") || !($input =~ /^[0-9]+$/) || ($input > $#dirs));
  return Auswahl($root.$dirs[$input]);
}


sub Hilfe
{
  printumlaute 
"Syntax: filesort rootdir kommando

Es wird mit jedem File im aktuellen Verzeichnis 'kommando' ausgeführt und dann
ein Menü mit allen Unterverzeichnissen von 'rootdir' angeboten, in die dann
das File verschoben wird.

";
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.
#
######################################################################
