———————package
Prty::Shell;
BEGIN {
$INC
{
'Prty/Shell.pm'
} ||= __FILE__;
}
use
strict;
use
warnings;
use
utf8;
our
$VERSION
= 1.121;
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 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
=head4 Description
Instantiiere ein Shell-Objekt, und liefere eine Referenz auf dieses
Objekt zurück.
=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 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 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 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'
};
$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
) {
if
(
$exit
> 255) {
$exit
=
int
(
$exit
/256);
}
return
$exit
;
}
return
;
}
# -----------------------------------------------------------------------------
=head2 Arbeitsverzeichnis wechseln
=head3 cd() - Wechsele das Arbeitsverzeichnis
=head4 Synopsis
$sh->cd($dir);
=head4 Returns
Die Methode liefert keinen Wert zurück.
=head4 Description
Wechsle in Arbeitsverzeichnis $dir. Anmerkung: Diese Änderung gilt
für den gesamten Prozess, nicht nur für das Shell-Objekt.
=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'
};
$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'
};
$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 Returns
nichts
=head4 Description
Prüfe den Status einer vorhergehenden Programmausführung und löse
eine Execption aus, wenn der Status ungleich 0 ist.
=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.121
=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