FSEITZ / Quiq-1.225 / lib / Quiq / Exit.pm 

            

              
1
—
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
—
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
—
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149

              
# -----------------------------------------------------------------------------
=encoding utf8
=head1 NAME
Quiq::Exit - Prüfe Exitstatus von Child-Prozess
=head1 BASE CLASS
L<Quiq::Object>
=head1 DESCRIPTION
Die Klasse implementiert eine einzelne Methode. Diese prüft den Status
eines terminierten Child-Prozesses. Im Fehlerfall löst sie eine
Exception aus.
=cut
# -----------------------------------------------------------------------------
package Quiq::Exit;
use base qw/Quiq::Object/;
use v5.10;
use strict;
use warnings;
our $VERSION = '1.225';
use Cwd ();
# -----------------------------------------------------------------------------
=head1 METHODS
=head2 Klassenmethoden
=head3 check() - Prüfe den Status eines terminierten Child-Prozesses
=head4 Synopsis
  $this->check;
  $this->check($exitCode);
  $this->check($exitCode,$cmd);
=head4 Arguments
=over 4
=item $exitCode (Default: $?)
(Integer) Der Returnwert von system() oder $? im Falle von qx// (bzw. ``).
=item $cmd (Default: undef)
(String) Ausgeführtes Kommando. Dieses wird im Fehlerfall
in den Exception-Text eingesetzt.
=back
=head4 Description
Prüfe den Status eines terminierten Child-Prozesses und löse
eine Execption aus, wenn dieser ungleich 0 ist.
=head4 Examples
Prüfe den Status nach Aufruf von system():
  my $r = system($cmd);
  Quiq::Exit->check($r,$cmd);
Minimale Variante (Prüfung über $?):
  system($cmd);
  Quiq::Exit->check;
Prüfe den Status nach Anwendung des Backtick-Operators:
  $str = `$cmd`;
  Quiq::Exit->check($?,$cmd);
=cut
# -----------------------------------------------------------------------------
sub check {
    my $this = shift;
    my $exitCode = shift;
    my $cmd = shift;
    if ($exitCode == 0) {
        return; # ok
    }
    elsif ($exitCode == -1) {
        $this->throw(
            'CMD-00001: Failed to execute command',
            Command => $cmd,
            ErrorMessage => $!,
        );
    }
    elsif ($exitCode & 127) {       # Abbruch mit Signal
        my $sig = $exitCode & 127;  # unterste 8 Bit sind Signalnummer
        my $core = $exitCode & 128; # das 8. Bit zeigt Coredump an
        $this->throw(
            'CMD-00003: Child died with signal',
            Signal => $sig.($core? ' (Coredump)': ''),
            Command => $cmd,
            ErrorMessage => $!,
        );
    }
    $exitCode >>= 8;
    $this->throw(
        'CMD-00002: Command failed with error',
        ExitCode => $exitCode,
        Command => $cmd,
        Cwd => Cwd::getcwd,
        ErrorMessage => $!,
    );
}
# -----------------------------------------------------------------------------
=head1 VERSION
1.225
=head1 AUTHOR
Frank Seitz, L<http://fseitz.de/>
=head1 COPYRIGHT
Copyright (C) 2025 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