#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use Encode;

###########################################################
# Def
my @pfade = ("test_archive_broschüre");            # Quelle(n)
my $ziel_zip = 'test.zip';                      # Zieldatei
my $siebenzip = 'c:/programme/7-zip/7z.exe';    # Installationsort 7-Zip
my $comp_rate = 9;                              # Komprimierungsgrad
                                                # von 0/garnicht+schnell bis 9/stark+langsam

###########################################################
# Pre
say("\n\n\n".('-' x 80)."\ngeht los");
close(STDERR);  # alternativ umleiten je nach Einsatzort
# 7-Zip gibt Fehler auf STDERR und STDOUT aus
# und da STDOUT schon geholt wird brauchen wir STDERR nicht auch noch
my $output = `"$siebenzip" -h`;
if ($output =~ /^7-zip \[(\d\d)\] (\d+)\.(\d+).+(\d\d\d\d)-(\d\d)-(\d\d)$/im) {
    say("Installierte Version von 7-Zip: $2.$3 vom $6.$5.$4 in $1 Bit Architektur");

    if (!-f $ziel_zip || unlink($ziel_zip)) {
        $_ =~ s/\//\\/g for @pfade;
        my $quellen = '"'.join('" "',@pfade);
        $quellen .= ($quellen !~ /\\$/ && $quellen !~ /\*$/? '\\' : '')
            .($quellen !~ /\*\.\*$/ ? '*.*' : '');
        my $kommando = join(' ',(
            '"'.$siebenzip.'"',
            'a',                # add / hinzufügen
            '-r',               # recurse / Unterverzeichnisse einschließen
            "-mx=$comp_rate",   # set compression Method / Komprimierungsstärke
            $ziel_zip,
            $quellen,
        ));
        $output = `$kommando`;
        my $regex_mit_verz = qr{
Scanning the drive:
(\d+) folder([s]?), (\d+) file([s]?), (\d+) bytes(.*)

Creating archive: $ziel_zip

Items to compress: (\d+)


Files read from disk: (\d+)
Archive size: (\d+) bytes(.+)
Everything is Ok
}m;
        my $regex_ohne_verz = qr{
Scanning the drive:
(\d+) file([s]?), (\d+) bytes(.*)

Creating archive: $ziel_zip

Items to compress: (\d+)


Files read from disk: (\d+)
Archive size: (\d+) bytes(.+)
Everything is Ok
}m;
        my $fertig = sub {
            my ($ma) = @_;
            my ($quelle_verz,$quelle_dateien,$quelle_bytes,$ziel_anz_gesamt,$ziel_bytes);
            if (scalar(@$ma) == 10) {
                $quelle_verz = $ma->[0];
                $quelle_dateien = $ma->[2];
                $quelle_bytes = $ma->[4];
                $ziel_anz_gesamt = $ma->[6];
                $ziel_bytes = $ma->[8];
            }
            else {
                $quelle_verz = 0;
                $quelle_dateien = $ma->[0];
                $quelle_bytes = $ma->[2];
                $ziel_anz_gesamt = $ma->[4];
                $ziel_bytes = $ma->[6];
            }
            if ($quelle_verz + $quelle_dateien == $ziel_anz_gesamt) {
                if ($quelle_bytes) {
                    my $rate = int(100 / $quelle_bytes * $ziel_bytes);
                    if ($rate != 100) {
                        say("Komprimierung erfolgte, das ZIP betraegt $rate % von der Summe der"
                            ." Ursprungsgroesse aller Dateien ($ziel_bytes von $quelle_bytes Byte)");
                    }
                    else {
                        say("Es wurde keine (nennenswerte) Komprimierung durchgefuehrt");
                    }
                }
                else {
                    say("In dem/den Quellverzeichnis/-sen wurde/-n keine Datei/-en gefunden");
                    if (!$ziel_anz_gesamt) {
                        say("Das ZIP ist leer");
                    }
                }
            }
            else {
                say("Fehler in ".__LINE__.": $quelle_verz Verzeichnis/-se + $quelle_dateien"
                    ." Datei/-en != $ziel_anz_gesamt Element/-e");
                exit();
                # die() ist hier nicht angezeigt, weil dessen Text auf STDERR
                # gehen würde, was wir aber oben geschlossen hatten
            }
        };
        if ($output =~ $regex_mit_verz || $output =~ $regex_ohne_verz) {
            my @matches = map {;no strict 'refs'; $$_} 1 .. $#-;
            # $matches[0] = $1  $matches[1] = $2  $matches[2] = $3 usw.
            # Quelle: http://www.perlmonks.org/?node_id=959528
            $fertig->(\@matches);
        }
        else {
            say("Fehler in ".__LINE__.":\n$output\n");
            exit();
        }
    }
    else {
        say("Fehler in ".__LINE__);
        exit();
    }
}
else {
    say("Fehler in ".__LINE__);
    exit();
}

###########################################################
# End
say("Fertig\n".('-' x 80));