package Prty::Shell;
BEGIN {
    $INC{'Prty/Shell.pm'} ||= __FILE__;
}
use base qw/Prty::Hash/;

use strict;
use warnings;
use utf8;

our $VERSION = 1.111;

use Time::HiRes ();
use Prty::Option;
use Prty::Converter;
use Prty::Path;
use Prty::Process;
use Cwd ();

# -----------------------------------------------------------------------------

=encoding utf8

=head1 NAME

Prty::Shell - Ausführung von Shell-Kommandos

=head1 BASE CLASS

L<Prty::Hash>

=head1 METHODS

=head2 Konstruktor/Destruktor

=head3 new() - Konstruktor

=head4 Synopsis

    $sh = $class->new(@opt);

=head4 Description

Instantiiere ein Shell-Objekt, und liefere eine Referenz auf dieses
Objekt zurück.

=head4 Options

=over 4

=item cmdPrefix => $str (Default: '')

Zeichenkette, der jeder Kommandozeile im Log vorangestellt wird.

=item dryRun => $bool (Default: 0)

Führe Kommandos nicht aus, sondern logge sie nur (impliziert log=>1).

=item log => $bool (Default: 0)

Log Commands to STDOUT.

=item logDest => $fd (Default: *STDOUT)

Datei-Deskriptor, auf den die Logmeldungen geschrieben werden.

=item msgPrefix => $str (Default: '')

Zeichenkette, die jeder Meldung im Log vorangestellt wird.

=item time => $bool (Default: 0)

Gib nach jedem Kommando die Zeit aus, die es benötigt hat.

=item timePrefix => $str (Default: '')

Zeichenkette, die jeder Zeitausgabe vorangestellt wird.

=item timeSummary => $bool (Default: 0)

Gib zum Schluss bei der Destrukturierung des Objekts
die Gesamtausführungszeit aus.

=back

=cut

# -----------------------------------------------------------------------------

sub new {
    my $class = shift;
    # @_: @keyVal

    my $self = $class->SUPER::new(
        cmdPrefix=>'',
        dryRun=>0,
        dirStack=>[],
        log=>0,
        logDest=>*STDOUT,
        msgPrefix=>'',
        time=>0,
        timePrefix=>'',
        timeSummary=>0,
        t0=>Time::HiRes::gettimeofday,
    );
    $self->set(@_);

    return $self;
}

# -----------------------------------------------------------------------------

=head3 DESTROY() - Destruktor

=head4 Synopsis

    $sh->%METH;

=head4 Description

Wenn timeSummary gesetzt ist, wird im Zuge der Destruktuierung
die Gesamtausführungszeit für alle Kommandos, die über das
Shell-Objekt ausgeführt wurden, ausgegeben.

=cut

# -----------------------------------------------------------------------------

sub DESTROY {
    my $self = shift;

    if ($self->{'timeSummary'}) {
        (my $prog = $0) =~ s|.*/||;
        my $pre = $self->{'msgPrefix'};
        my $t = Time::HiRes::gettimeofday - $self->{'t0'};
        my $fd = $self->{'logDest'};
        printf $fd "%sAusführungszeit %s: %d Min. %d Sek.\n",
            $pre,$prog,$t/60,$t%60;
    }

    return;
}

# -----------------------------------------------------------------------------

=head2 Kommando ausführen

=head3 exec() - Führe Kommando aus

=head4 Synopsis

    $str|@arr = $this->exec($cmd,@opt);

=head4 Description

Führe Kommando $cmd aus. Im Falle eines Fehlers löse eine Exception aus.

Beginnt das Kommando $cmd mit einem Bindestrich, wird
implizit die Option -sloppy gesetzt.

=head4 Options

=over 4

=item -capture => $channels (Default: keiner)

Liefere die die Programmausgabe auf dem Kanal bzw. den Kanälen
$channels zurück. Mögliche Werte für $channels:

=over 4

=item 'stdout'

Liefere Ausgabe auf stdout, unterdrücke stderr.

=item 'stderr'

Liefere Ausgabe auf stderr, unterdrücke stdout.

=item 'stdout+stderr'

Liefere Ausgabe auf stdout und stderr zusammen.

=item 'stdout,stderr'

Liefere Ausgabe auf stdout und stderr getrennt.

=back

Für Beispiele siehe Abschnitt L</exec/Examples>.

=item -quiet => $bool (Default: 0)

Unterdrücke Programmausgabe auf stdout und stderr.

=item -sloppy => $bool (Default: 0)

Wirf keine Exception, wenn das Programm fehlschlägt, sondern
liefere dessen Exitcode. Ist gleichzeitig die Option -capture angegeben,
hat diese hinsichtlich des Rückgabewerts Priorität.

=back

=head4 Returns

Der Rückgabewert richtet sich nach den Optionen @opt. Ist -capture
definiert, wird die angegebene Programmausgabe geliefert. Ist
-sloppy wahr, wird der Exitcode geliefert. Die Option -capture hat
Priorität gegenüber der Option -sloppy.  Sind weder -capture noch
-sloppy angegeben, liefert die Methode keinen Wert.

=head4 Examples

Unterdrücke Ausgabe auf stdout und stderr:

    $this->exec($cmd,-quiet=>1);

Liefere Ausgabe auf stdout:

    $stdout = $this->exec($cmd,-capture=>'stdout');

Liefere Ausgabe auf stderr:

    $stderr = $this->exec($cmd,-capture=>'stderr');

Liefere Ausgabe auf stdout und stderr zusammen:

    $output = $this->exec($cmd,-capture=>'stdout+stderr');

Liefere Ausgabe auf stdout und stderr getrennt:

    ($stdout,$stderr) = $this->exec($cmd,-capture=>'stdout,stderr');

Keine Exception, liefere Exitcode:

    $exitCode = $this->exec($cmd,-sloppy=>1);

=cut

# -----------------------------------------------------------------------------

sub exec {
    my $self = ref $_[0]? shift: shift->new;
    my $cmd = shift;

    # Optionen

    my $capture = undef;
    my $quiet = 0;
    my $sloppy = 0;

    if (@_) {
        Prty::Option->extract(\@_,
            -capture=>\$capture,
            -quiet=>\$quiet,
            -sloppy=>\$sloppy,
        );
    }

    # Exception?

    my $except = 1; # löse Exception aus
    if ($sloppy || $cmd =~ s/^-//) {
        $except = 0;
    }

    # Umleitungen aufsetzen

    if ($quiet) {
        $cmd = "($cmd) >/dev/null 2>&1";
        $capture = undef;
    }

    my $qx = 0;
    my $stdoutFile = "/tmp/$$.stdout";
    my $stderrFile = "/tmp/$$.stderr";

    if (!$capture) {
        # nichts tun
    }
    elsif ($capture eq 'stdout') {
        $cmd = "($cmd) 2>/dev/null";
        $qx = 1;
    }
    elsif ($capture eq 'stderr') {
        $cmd = "($cmd) 2>&1 1>/dev/null";
        $qx = 1;
    }
    elsif ($capture eq 'stdout+stderr') {
        $cmd = "($cmd) 2>&1";
        $qx = 1;
    }
    elsif ($capture eq 'stdout,stderr') {
        $cmd = "($cmd) 1>$stdoutFile 2>$stderrFile";
    }
    else {
        $self->throw(
            q{CMD-00004: Ungültiger Wert für -capture},
            Capture=>$capture,
        );
    }

    #if ($quiet) {
    #    $cmd = "($cmd) 1>/dev/null 2>/dev/null";
    #}

    # Kommando protokollieren

    my $dryRun = $self->{'dryRun'};
    my $log = $self->{'log'};

    if ($log || $dryRun) {
        my $pre = $self->{'cmdPrefix'};
        my $fd = $self->{'logDest'};
        print $fd "$pre$cmd\n";
    }

    # Kommando ausführen

    my $exit = 0;
    my $output;
    unless ($dryRun) {
        my $t0 = Time::HiRes::gettimeofday;
        if ($qx) {
            $output = qx/$cmd/;
        }
        else {
            system $cmd;
        }
        $exit = $?;
        my $t1 = Time::HiRes::gettimeofday;
        if ($log && $self->{'time'}) {
            my $fd = $self->{'logDest'};
            # printf $fd "/* %.2f */\n",$t1-$t0;
            printf "%s%s\n",$self->{'timePrefix'},
                Prty::Converter->epochToDuration($t1-$t0,1,3);
        }
        if ($except) {
            # geht sonst beim Autoload von checkError() verloren
            my $msg = $!;
            $self->checkError($exit,$msg,$cmd);
        }
    }

    # Returnwerte

    if ($capture) {
        if ($capture eq 'stderr+stdout') {
            my $stdout = Prty::Path->read($stdoutFile,-delete=>1);
            my $stderr = Prty::Path->read($stderrFile,-delete=>1);
            return ($stdout,$stderr);
        }
        return $output;
    }
    elsif (!$except) {
        return $exit;
    }

    return;
}

# -----------------------------------------------------------------------------

=head2 Arbeitsverzeichnis wechseln

=head3 cd() - Wechsele das Arbeitsverzeichnis

=head4 Synopsis

    $sh->cd($dir);

=head4 Description

Wechsle in Arbeitsverzeichnis $dir. Anmerkung: Diese Änderung gilt
für den gesamten Prozess, nicht nur für das Shell-Objekt.

=head4 Returns

Die Methode liefert keinen Wert zurück.

=cut

# -----------------------------------------------------------------------------

sub cd {
    my ($self,$dir) = @_;

    my $dryRun = $self->{'dryRun'};
    my $log = $self->{'log'};

    if ($log || $dryRun) {
        my $pre = $self->{'cmdPrefix'};
        my $fd = $self->{'logDest'};
        print $fd "${pre}cd $dir\n";
    }

    my $cwd = Prty::Process->cwd;
    unless ($dryRun) {
        my $t0 = Time::HiRes::gettimeofday;
        Prty::Process->cwd($dir);
        my $t1 = Time::HiRes::gettimeofday;

        if ($log && $self->{'time'}) {
            my $fd = $self->{'logDest'};
            printf $fd "/* %4.2f sec */\n",$t1-$t0;
        }
    }
    push @{$self->{'dirStack'}},$cwd;

    return;
}

# -----------------------------------------------------------------------------

=head3 back() - Wechsele ins vorige Arbeitsverzeichnis zurück

=head4 Synopsis

    $this->back;

=cut

# -----------------------------------------------------------------------------

sub back {
    my $self = shift;

    my $dir = pop @{$self->{'dirStack'}};
    unless ($dir) {
        return;
    }

    my $dryRun = $self->{'dryRun'};
    my $log = $self->{'log'};

    if ($log || $dryRun) {
        my $pre = $self->{'cmdPrefix'};
        my $fd = $self->{'logDest'};
        print $fd "${pre}cd $dir\n";
    }

    unless ($dryRun) {
        my $t0 = Time::HiRes::gettimeofday;
        Prty::Process->cwd($dir);
        my $t1 = Time::HiRes::gettimeofday;

        if ($log && $self->{'time'}) {
            my $fd = $self->{'logDest'};
            printf $fd "/* %.2f */\n",$t1-$t0;
        }
    }

    return;
}

# -----------------------------------------------------------------------------

=head2 Fehlerbehandlung

=head3 checkError() - Löse Exception bei Kommandofehler aus

=head4 Synopsis

    $this->checkError($code,$errMsg,@cmd);

=head4 Description

Prüfe den Status einer vorhergehenden Programmausführung und löse
eine Execption aus, wenn der Status ungleich 0 ist.

=head4 Returns

nichts

=head4 Examples

Prüfe den Ausführungsstatus von system():

    system($cmd);
    Prty::Shell->checkError($?,$!,$cmd);

Prüfe den Ausführungsstatus des Backtick-Operators:

    $str = `$cmd`;
    Prty::Shell->checkError($?,$!,$cmd);

=cut

# -----------------------------------------------------------------------------

sub checkError {
    my $this = shift;
    my $errCode = shift;   # $?
    my $errMsg = shift;    # $!
    my $cmd = join ' ',@_; # Kommando

    if ($errCode == 0) {
        return; # ok
    }
    elsif ($errCode == -1) {
        $this->throw(
            q{CMD-00001: Kommando konnte nicht aufgerufen werden},
            Command=>$cmd,
            ErrorMessage=>$errMsg,
        );
    }
    elsif ($errCode & 127) {       # Abbruch mit Signal
        my $sig = $errCode & 127;  # unterste 8 Bit sind Signalnummer
        my $core = $errCode & 128; # 8. Bit zeigt Coredump an
        $this->throw(
            q{CMD-00003: Kommando wurde abgebrochen},
            Signal=>$sig.($core? ' (Coredump)': ''),
            Command=>$cmd,
            ErrorMessage=>$errMsg,
        );
    }
    $errCode >>= 8;
    $this->throw(
        q{CMD-00002: Kommando endete mit Fehler},
        ExitCode=>$errCode,
        Command=>$cmd,
        Cwd=>Cwd::getcwd,
        ErrorMessage=>$errMsg,
    );
}

# -----------------------------------------------------------------------------

=head1 VERSION

1.111

=head1 AUTHOR

Frank Seitz, L<http://fseitz.de/>

=head1 COPYRIGHT

Copyright (C) 2017 Frank Seitz

=head1 LICENSE

This code is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

# -----------------------------------------------------------------------------

1;

# eof
