#!/usr/bin/perl -w

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


# To-Do:
# - Fehler abfangen, wenn mehr als 105 (?) Files ins Root der Disk
#   geschrieben werden.

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;
use File::Basename;
use File::Copy;


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

$version = '0.9';
$appname = 'Fit';


# Eine 3.5"-Disk mit 1.44MB hat 2847 Sektoren zu je 512  Bytes,
#      also 1457664 Bytes
# Eine 3.5"-Disk mit 720KB  hat 713  Sektoren zu je 1024 Bytes.
$SektorSize  = 512;
$MaxDiskSize = 1457664; # Soviel paßt maximal auf eine Disk.


$linux    = ($osname eq "linux");
$hpux     = ($osname eq "hpux");
$solaris  = ($osname eq "solaris");
$dos      = ($osname eq "dos");
if ( !$linux && !$hpux && !$solaris && !$dos)
{ die "Die Platform '$osname' ist noch nicht unterstuetzt!\n"}

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

&Hilfe if ($#ARGV<0);

unless ($dos)
{
  die "Kann 'mdir' nicht auf dem Pfad finden!\n"  unless which('mdir');
  die "Kann 'mcopy' nicht auf dem Pfad finden!\n" unless which('mcopy');
}

$NamenKuerzen = $FALSE;
if (!$dos)
{
  $NamenKuerzen = $TRUE unless `mcopy -V` =~ /M.+ version (pre\d+-)?3.\d+/;
}
if ($NamenKuerzen)
{
  print "Filenamen werden auf DOS-Namen gekürzt.\n";
}
else
{
  print "Es werden lange Filenamen mittels VFAT (MTools 3.0) geschrieben.\n";
}

$temp = GetTempDir();
unless (defined $temp)
{ printumlaute "Ich kann kein temporäres Verzeichnis finden!\n"; exit; }

select(STDERR); $|=1; select(STDOUT); $|=1;

printumlaute Kopf();

######################################################################
### Signal-Handler
######################################################################

sub catch_signal
{
  my $signame = shift;
  undef %SIG; # Keine weiteren Signale
  print "Ende von fcopy wegen Signal SIG$signame.\n";
  &ProgrammEnde;
}

$SIG{HUP}  = \&catch_signal;   #1 : Hangup detected on controlling terminal or death of controlling process
$SIG{INT}  = \&catch_signal;   #2 : Interrupt from keyboard
$SIG{QUIT} = \&catch_signal;   #3 : Quit from keyboard
$SIG{ABRT} = \&catch_signal;   #6 : Abort signal from abort(3)
$SIG{KILL} = \&catch_signal;   #9 : Kill signal
# $SIG{PIPE} = \&catch_signal;   #13: Pipe unterbrochen
$SIG{TERM} = \&catch_signal;   #15: Termination signal
# $SIG{ALRM} = \&catch_signal;   # Alarm



######################################################################
### Parameter einlesen und testen
######################################################################


$ziel = pop(@ARGV);
# Testen, ob Zielangabe gültig ist
unless ( $ziel =~ /[a-zA-Z]:/ )
{ printumlaute "Ziel \"$ziel\" ungültig!\n"; exit; }


# Optionen einlesen
$argument = $ARGV[0];
$move     = $FALSE;
$verify   = $FALSE;
$verifyC  = $FALSE;
$save     = $FALSE;
$debug    = $FALSE;
$SaveDir  = "";
while ( defined $argument && substr($argument,0,1) eq "-" )
{
 SWITCH:
  {
    if ($argument eq "-m") { $move = $TRUE; shift @ARGV; last SWITCH; }
    if ($argument eq "-s")
    {
      # Testen, ob angegebenes Verzeichnis existiert
      shift @ARGV;
      $SaveDir = $ARGV[0];
      if (! -d $SaveDir)
      { die "Sicherungskopieverzeichnis $SaveDir existiert nicht!\n"; };
      $save = $TRUE;
      shift @ARGV;
      last SWITCH;
    }
    if ($argument eq "-v") { $verify  = $TRUE; shift @ARGV; last SWITCH; }
    if ($argument eq "-d") { $debug   = $TRUE; shift @ARGV; last SWITCH; }
    # Sonst:
    die "Option '$argument' gibt es nicht!\n";
  }
  $argument = $ARGV[0];
}


if ($MeinName =~ /fmove/i) { $move = $TRUE }


if ( $save && !$move )
{ print "Warnung: Sie Option '-s' hat keine Wirkung ohne '-m'!\n"; }


if ($debug)
{
  print "Optionen:\n";
  print "Move:       $move\n";
  print "Verifiy(v): $verify\n";
  print "Verifiy(V): $verifyC\n";
  print "Save:       $save (Verzeichnis: $SaveDir)\n\n";
}


unless (defined $ARGV[0])
{
  die "Keine Files angegeben!\n";
}


# Bei "fcopy . a:" das draus machen: "fcopy * a:"
if ($ARGV[0] eq '.')
{
  shift;
  if ($dos)
  { foreach $_ (dosglob('*.*')) { unshift @ARGV,$_ } }
  else
  { foreach $_ (glob('*'  ))    { unshift @ARGV,$_ } }
}

# Unter DOS müssen Joker expandiert werden
if ($dos)
{
  @files = ();
  foreach $param (@ARGV) # Alle Parameter durchgehen
  {
    push @files, dosglob($param);
  }
  @ARGV = @files;
  undef @files;
}

for ( $i=0, $fc=0; $i<=$#ARGV; $i++ )
{
  $name = $ARGV[$i];
  # Prüfung der Files
  if ( ! -r $name ) { print "File: '$name' ist nicht lesbar.\n";       next }
  if ( ! -e $name ) { print "File: '$name' existiert nicht.\n";        next }
  if (   -d $name ) { print "File: '$name' ist ein Verzeichnis.\n";    next }
  if ( ! -f $name ) { print "File: '$name' ist kein normales File.\n"; next }
  $size = (stat($name))[7];
  # Zu große Files abweisen
  if ( $size > $MaxDiskSize )
  {
    printumlaute "File $name ist größer als der maximal freie Diskettenplatz!\n";
    $ZuGross{$name} = $TRUE;
    next;
  }
  # Auch ein leeres File braucht einen Sektor
  if ($size==0) { $size=1 };
  $size = int(($size+$SektorSize-1)/$SektorSize)*$SektorSize;
  $files[$fc] = "$name $size\n";
  $fc++;
}


# Merken, welche Files nicht kopiert sind
foreach $_ (@files)
{
  my ($name,$size) = SplitFileSize($_);
  $NichtKopiert{$name} = $TRUE;
}


# Sortieren
@files = sort SizeSort @files;


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


# Solange Files zu kopieren sind
while (scalar %NichtKopiert)
{


  # Freien Diskettenplatz feststellen

  if ($dos)
  {
    $disksize = df($ziel);
    # DIR liefert bei leeren Disketten und nicht vorhandenen Disks nichts.
    unless (defined $disksize)
    {
      unless( mkdir $ziel.'/df-test.\$\$\$',0755 )
      {
	print "Keine Diskette eingelegt!\n";
	exit;
      }
      else
      {
	$disksize = df($ziel);
	rmdir $ziel.'/df-test.\$\$\$';
	$disksize += 1024 if $disksize == 729088; # 720K-Disks
	$disksize +=  512 if $disksize == 1457152;
      }
    }
    unless (defined $disksize)
    {
      print "Kann freien Speicherplatz nicht feststellen!\n";
      exit;
    }
  }
  else
  {
    open(TESTDISK, "mdir $ziel 2>&1 |");
    @mdiroutput = <TESTDISK>;
    close TESTDISK;

    # Testen, ob MDIR Erfolg hatte
    @mdirfehler = grep ( /[Cc]annot\s+initialize|init: open: No such file or directory/, @mdiroutput);
    die "FEHLER: @mdirfehler\n" if @mdirfehler;

    #@testdisk = grep(/^\s+(\d+.*)\s+bytes free/, @mdiroutput);
    # MDIR gibt eine Zeile der Art aus: "              1 415 168 bytes free"
    # oder evtl. auch                   "   0 File(s)  1 415 168 bytes free"
    @testdisk = grep(/^.+?\s+[\d\s\.]+\s+bytes free/, @mdiroutput);

    # Der MDIR unter HPUX und Solaris liefert bei leeren Disks nichts zurück,
    # deshalb nehme ich das einfach so an.
    if ( ! defined($testdisk[0]) )
    {
      if (!$hpux && !$solaris)
      { die "MDIR liefert keinen Wert! Abbruch.\n" }
      $disksize = "     0 File(s)     $MaxDiskSize bytes free";
    }
    else
    { $disksize = $testdisk[0] }

    $disksize =~ s/^.+?\s+([\d\s\.]+)\s+bytes free/$1/;
    $disksize =~ s/\s//g;
  }

  print "Auf Diskette $ziel sind $disksize Bytes frei.\n";


  # Zu große Files abweisen:
  for ( $i=0; $i<=$#files; $i++ )
  {
    next unless defined $files[$i];
    ($name,$size) = SplitFileSize($files[$i]);
    # Wenn File größer als Disk:
    next if ( $size > $disksize ); # Dann probierens wir mit der nächsten Disk
  }

  $NochFrei = $disksize;

  for ( $i=0; $i<=$#files; $i++ )
  {
    next if (! defined($files[$i]));
    ($name,$size) = SplitFileSize($files[$i]);
    # Wenn File größer als Disk:
    next if ( $size > $NochFrei );
    # Ansonsten nehmen wir das File und kopieren es.
    $NochFrei = $NochFrei-$size;
    &Kopiere ($name,$size);
    undef($files[$i]);
    delete ($NichtKopiert{$name}); # Jetzt ist es kopiert
  }

  print "\a"; # Piep!
  if ($move) { &Loeschen }
  print "Es sind noch $NochFrei Bytes auf dieser Diskette frei.\n";

  # Wenn im Environment ein Auswurf-Kommando definiert wurde, dann damit
  # auswerfen:
  if (defined $ENV{FCOPY_EJECT})
  {
    system($ENV{FCOPY_EJECT});
  }

  if (scalar %NichtKopiert)
  {
    printumlaute "Bitte nächste Diskette einlegen!\n";
    $dummy = "";
    $dummy = <STDIN>;
    print "Weiter gehts...\n";
  }



} # Haupt-Schleife ( while (@files) )


&ProgrammEnde;




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


sub SplitFileSize
{
  # Es wird sowas: "einfilename.endung 12345"
  # in die beiden Komponenten zerlegt.
  # Funktioniert auch, wenn der Filename Spaces beinhaltet.

  my $zusammen = shift;
  $zusammen =~ /^(.+)\s+([^\s]+)$/;
  return $1, $2;
}


sub Vergleiche
{
  my $name     = shift;
  my $diskname = shift;
  my $tempfile = "$temp/fcopy.$$";

  print "Ich vergleiche $name mit der Kopie auf der Diskette ... ";
  if (! $dos)
  {
    # Hier muesste man vorher per IOCTL() einen FLush auf /dev/fdX
    # machen, da sonst nur aus dem Cache gelesen wird.
    my $file = '';
    my $disk = '';

    open(FILE, "<$name") || die "Kann Datei '$name' nicht lesen!\n";
    read(FILE, $file, -s FILE);
    close FILE;

    system ("mcopy '$ziel$diskname' $tempfile 2>/dev/null");
    open(DISK, "<$tempfile") || die "Kann Datei '$tempfile' nicht lesen!\n";
    read(DISK, $disk, -s DISK);
    close DISK;
    unlink $tempfile;

    if ($file eq $disk) { return "OK"     }
    else                { return "FEHLER" }
  }
  if ($dos)
  {
    printumlaute "\nVergleich ist unter DOS erst möglich, wenn read() funktioniert!\n";
    return "OK"
  }
}


sub DosName
{
  my $name = shift;
  my ($kurz,$pfad);
  # Falls File mit Pfad angegeben wurden, dann muß man diesen abschneiden.
  ($kurz,$pfad) = fileparse($name,'');
  $pfad = '' if ($pfad eq '.'); # BugFix f�r HPUX.
  my $vorne  = '';
  my $hinten = '';
  $_ = $kurz;
  # Wenn ein Punkt drin ist
  if (/\./)
  {
    /(.*)\.(.*)/; # Findet den letzten Punkt
    $vorne  = $1;
    $hinten = $2;
    $vorne = 'X' if ($vorne eq ''); # ".emacs" -> "x.emacs"
    $vorne  =~ s/\./X/g;            # Punkte zu "X"
    $vorne  = substr($vorne, 0,8);
    $hinten = substr($hinten,0,3);
  }
  else
  {
    $vorne  = substr($kurz,0,8);
    $hinten = '';
  }
  $kurz = "$vorne.$hinten";
  $kurz =~ s/\.$//; # Punkt am Ende entfernen

  # Sonderzeichen eliminieren
  $kurz =~ tr /+?*: /X/;

  if ($pfad eq "./") { $pfad = '' }
  if ($name ne $pfad.$kurz)
  {
    printumlaute "Namensänderung war notwendig:\n";
    print "Alter Name: '$name'\n";
    print "Dos-Name:   '$kurz'\n";
  }
  return $kurz;
}


sub Kopiere
{
  my $name = shift;
  my $size = shift;
  my $diskname = $name;

  # Evtl. vorhandenen Pfad abscheiden
  $diskname =~ s/^.+${slashsuch}([^${slashsuch}]+)$/$1/;

  if ($NamenKuerzen) { $diskname = &DosName($name) }
  print "Ich kopiere $diskname ($size Bytes) ...\n";
  if ($dos)
  { FileCopySecure($name, "$ziel$slash$diskname", $FCS_COPY, $FCS_PRINT) }
  else
  { system("mcopy -m '$name' '$ziel$diskname'") }
  my $fehler = $?;

  if ($verify)
  {
    my $vergl = &Vergleiche($name,$diskname);
    print "$vergl\n";
    if ( $vergl eq "OK" ) { push @delfiles, $name }
    else
    {
      print "WARNUNG: File $name wurde fehlerhaft kopiert!\n";
      if ($move) { printumlaute "         (Es wird nicht gelöscht.)\n"}
    }
  }
  # Wenn kein Verify, dann Fehlercode des mcopy auswerten
  else
  {
    if ( $fehler == 0 )
    {
      push @delfiles, $name;
    }
    else
    {
      print "WARNUNG: File $name wurde fehlerhaft kopiert!\n";
      if ($move) { printumlaute "         (Es wird nicht gelöscht.)\n"}
    }
  }
}


sub Loeschen
{
  if ($save)
  {
    print "Ich erstelle die Sicherungskopien nach $SaveDir ...\n";
    foreach $file (@delfiles)
    {
      # Als Übergangsloesung schalte ich die Warnings aus.
      if ($^W)   { $^W = $FALSE }; # Warnings ausschalten
      copy ("$file", "$SaveDir$slash$file");
      if (! $^W) { $^W = $TRUE  }; # Warnings einschalten
    }
  }
  unlink @delfiles;
}


# Das nur, um "-w"-konform zu sein. :-)
$a="";
$b="";
sub SizeSort
{
  # Sortiert große Files nach "oben".
  my $dummy = '';
#  ($dummy,$Asize) = split(/[ \t\n]+/,$a);
#  ($dummy,$Bsize) = split(/[ \t\n]+/,$b);
  ($dummy,$Asize) = SplitFileSize($a);
  ($dummy,$Bsize) = SplitFileSize($b);
  $Bsize <=> $Asize;
}


sub ProgrammEnde
{
  if (scalar %NichtKopiert || scalar %ZuGross)
  {
    open (LOG, ">fcopy$$.log") || open (LOG, ">-");
    select(LOG); $|=1; select(STDOUT);
  }
  if (scalar %ZuGross)
  {
    # printumlaute(LOG,"Zu groß:\n");
    # printumlaute() kann nicht erkennen, daß LOG ein Filehandle ist!
    print LOG "Zu groß:\n";
    print LOG join("\n", keys %ZuGross), "\n";
  }
  if (scalar %NichtKopiert)
  {
    print LOG "Nicht kopiert:\n";
    print LOG join("\n", keys %NichtKopiert), "\n";
  }
  exit;
}


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


sub Hilfe
{
  printumlautepaged
  Kopf().
"Syntax:  $MeinName  Optionen  Files  Ziel

Es werden alle angegebenen Files auf evtl. mehrere Disketten kopiert
und dabei der Platzverbrauch optimiert.
Bei einem Abbruch wird ein log-File erstellt, das die Namen der noch nicht
kopierten Files enthaelt.

Beispiele:
$MeinName file1.txt file2.txt file3.txt a:
$MeinName f*.* a:
$MeinName -m -s ~/sicherung * b:

Optionen:
-d : Debug (viele Ausgaben des internen Status)
-m : bewirkt ein Verschieben (Löschen nach dem Kopieren.)
     Normalerweise wird FIT als fcopy ausgerufen.
     Wenn FIT als fmove (z.B. durch einen symbolischen Link) gestartet wird,
     dann ist die Kommandozeilenoption '-m' aktiv.
-s VERZ : Kopiert die Files nach MOVE zusätzlich in das Verzeichnis VERZ.
-v : Nach dem Kopieren byteweises Vergleichen der Files.
     Das wird aber durch einen Cache umgangen. (Abhilfe ???)

Environment:
FCOPY_EJECT : Wenn diese Variable definiert ist, dann wird nach dem Füllen
              der Diskette das Programm ausgeführt, das in FCOPY_EJECT
              definiert ist. Unter Solaris empfiehlt sich z.B. 'eject'.
";
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.
#
######################################################################