List files with distinct content only

use strict;
use warnings;
use Digest::file qw(digest_file); # Für die MD5-Prüfsumme

# Liefert eine Liste aller csv-Files im angegebenen Verzeichnis (arg1),
# deren Namen dem Suchmuster arg2 (regulärer Ausdruck) genügen.
# Von inhaltsidentischen Files wird nur das neueste beibehalten
# Zwei Files gelten als inhaltsidentisch, wenn
# 1.) ihre MD5-Prüfsumme identisch ist, ODER
# 2.) alle Zeilen in allen Zellwerten übereinstimmen mit Ausnahme der Spalten 1 und 5
#     Diese Spalten enthalten Zeitstempel der Form JJJJMMTTHHMMSS,
#     Die Files werden als identisch angesehen, selbst wenn diese Zeitstempel abweichen sollten
# Es werden zwei anwendungsspezifische Gruppierungskriterien (Lieferantenname, Typ) verwendet,
# sie stehen in der 2. und 3. Spalte der Fileinfos
# In anderen Kontexten kann man stattedessen in sub get_file_info() andere Kriterien aufbauen.

# Directory und Filenamen-Pattern aus Kommandozeile einlesen
if ($#ARGV < 1) {
  die "Syntax: perl zafm_get_files.pl <Directory> <Filename regexp>\n";
}

# Verzeichnis, ggf. schließenden Schrägstrich anfügen
my $DIR     = ( $ARGV[0] =~ s/(?<!\/|\\)$/\//r );
# Pattern als Filter für die Filenamen, z.B. (STAMM|BESTAND).*\.csv$
my $PATTERN = qr/$ARGV[1]/i;

# Alle Dateien, die dem Pattern genügen, aus dem Verzeichnis lesen
my @files = get_files( $DIR, $PATTERN );

# Dubletten ausdünnen (nur das jeweils neueste File stehenlassen)
delete_equal( \@files );

# csv-Ergebnisliste ausgeben
foreach my $file (@files) {
  print join( ",", ( $file->[0], $file->[4], $file->[3]))."\n";
}

# Dubletten aus der übergebenen Liste von Files entfernen
sub delete_equal {
  my ($files,$last,@files_new) = (shift);
  @$files = sort { $a->[1] cmp $b->[1] ||    # Lieferantenname
                   $a->[2] cmp $b->[2] ||    # Typ (STAMM oder BESTAND)
                   $a->[4] <=> $b->[4] ||    # Dateigröße
                   $a->[5] cmp $b->[5]       # MD5 Code
                 } @$files;
  foreach my $file (@$files) {
    push @files_new, $last = $file unless
      $last &&
      $file->[1] eq $last->[1] &&
      $file->[2] eq $last->[2] &&
      $file->[4] == $last->[4] &&
        ( $file->[5] eq $last->[5] ||
          equal_content( $file, $last));
  }
# Nach Dateinamen absteigend sortieren (=> pro Lief/Typ neuestes Datum zuerst)
  @$files = sort { $b->[0] cmp $a->[0] } @files_new;
}

# Zwei Files auf Inhaltsgleichheit testen
sub equal_content {

  my @files = @_[0,1];
  my @filenames = map { $DIR.$_->[0] } @files;
  my @fh = map { open_file( $_ ) } @filenames;

  my $equal = 1;
  while (my $row0 = readline $fh[0]) {
    my $row1 = readline $fh[1];
    last unless $equal &&= (
      $row1 &&
      length($row0) == length($row1) &&
      equal_rows( $row0, $row1 ));
  }

  close $fh[0];
  close $fh[1];
  return $equal;

}

# Zwei csv-Zeilen auf Gleichheit prüfen
sub equal_rows {
# Den Zeitstempel am Anfang und in der 5. Spalte beim Vergleich ignorieren
  my ($row0,$row1) = map { s/
    ^\d{14}         # 14 Ziffern am Anfang des Strings (KATALOGNR)
    (
      (?:;.*?){3}   # 3 Wiederholungen eines mit ; eingeleiteten Zellinhalts
      ;             # Ein 4. Semikolon am Ende dieser Zellinhalte
    )               # Diesen Abschnitt als $1 merken
    \d{14}          # Wieder 14 Ziffern in Spalte 5 (ART_LIEFERBAR_AB)
    /$1/rx          # Bei Substitution nur den Zwischenteil erhalten
                    # Die beiden Zeitstempel werden somit gelöscht
                    # Modifier 'r', um das Ergebnis der Substitution in 'map' zurückzugeben
  } @_;
  return $row0 eq $row1;
}

# Einige Dateieigenschaften anreichern
sub get_fileinfo {
  my ($dirname,$filename) = @_;
  my $file = $DIR.$filename;
  my ($lief_name,$type) = ( $filename =~ /^(.*)_(STAMM|BESTAND)/ );
  my @stat = stat $file;
  return [
      $filename,                   # 0: Filename (ohne DIR)
      $lief_name,                  # 1: Lieferantenname
      $type,                       # 2: STAMM | BESTAND
      $stat[9],                    # 3: UX Timestamp: Geändert am
      $stat[7],                    # 4: Size
      digest_file($file,"MD5")     # 5: MD5-Prüfsumme
    ]
}

# Liefert alle Dateinamen eines Verzeichnisses, die einem Pattern genügen
sub get_files {
  my ($dirname,$pattern) = @_;
  opendir my $dir, $dirname or die "Cannot open directory: $!";
  my @filenames = grep { -f "$dirname/$_" && $_ =~ $pattern } readdir $dir;
  my @files = map { get_fileinfo( $dirname,$_ ) } @filenames;
  closedir $dir;
  return @files;
}

# Eine Datei zum Lesen öffnen
sub open_file {
  my $filename = shift;
  open my $fh1, '<', $filename or die "Kann $filename nicht öffnen: $!";
  return $fh1;
}