OLD | NEW |
| (Empty) |
1 # This program is free software; you can redistribute it and/or modify | |
2 # it under the terms of the GNU General Public License as published by | |
3 # the Free Software Foundation; either version 2 of the License, or | |
4 # (at your option) any later version. | |
5 # | |
6 # This program is distributed in the hope that it will be useful, | |
7 # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
8 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
9 # GNU General Public License for more details. | |
10 # | |
11 # You should have received a copy of the GNU General Public License | |
12 # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
13 | |
14 package Dpkg::ErrorHandling; | |
15 | |
16 use strict; | |
17 use warnings; | |
18 | |
19 our $VERSION = '0.02'; | |
20 | |
21 use Dpkg (); | |
22 use Dpkg::Gettext; | |
23 | |
24 use Exporter qw(import); | |
25 our @EXPORT = qw(report_options info warning error errormsg | |
26 syserr subprocerr usageerr); | |
27 our @EXPORT_OK = qw(report); | |
28 | |
29 my $quiet_warnings = 0; | |
30 my $info_fh = \*STDOUT; | |
31 | |
32 sub report_options | |
33 { | |
34 my (%options) = @_; | |
35 | |
36 if (exists $options{quiet_warnings}) { | |
37 $quiet_warnings = $options{quiet_warnings}; | |
38 } | |
39 if (exists $options{info_fh}) { | |
40 $info_fh = $options{info_fh}; | |
41 } | |
42 } | |
43 | |
44 sub report(@) | |
45 { | |
46 my ($type, $msg) = (shift, shift); | |
47 | |
48 $msg = sprintf($msg, @_) if (@_); | |
49 return "$Dpkg::PROGNAME: $type: $msg\n"; | |
50 } | |
51 | |
52 sub info($;@) | |
53 { | |
54 print { $info_fh } report(_g('info'), @_) if (!$quiet_warnings); | |
55 } | |
56 | |
57 sub warning($;@) | |
58 { | |
59 warn report(_g('warning'), @_) if (!$quiet_warnings); | |
60 } | |
61 | |
62 sub syserr($;@) | |
63 { | |
64 my $msg = shift; | |
65 die report(_g('error'), "$msg: $!", @_); | |
66 } | |
67 | |
68 sub error($;@) | |
69 { | |
70 die report(_g('error'), @_); | |
71 } | |
72 | |
73 sub errormsg($;@) | |
74 { | |
75 print { *STDERR } report(_g('error'), @_); | |
76 } | |
77 | |
78 sub subprocerr(@) | |
79 { | |
80 my ($p) = (shift); | |
81 | |
82 $p = sprintf($p, @_) if (@_); | |
83 | |
84 require POSIX; | |
85 | |
86 if (POSIX::WIFEXITED($?)) { | |
87 error(_g('%s gave error exit status %s'), $p, POSIX::WEXITSTATUS($?)); | |
88 } elsif (POSIX::WIFSIGNALED($?)) { | |
89 error(_g('%s died from signal %s'), $p, POSIX::WTERMSIG($?)); | |
90 } else { | |
91 error(_g('%s failed with unknown exit code %d'), $p, $?); | |
92 } | |
93 } | |
94 | |
95 my $printforhelp = _g('Use --help for program usage information.'); | |
96 | |
97 sub usageerr(@) | |
98 { | |
99 my ($msg) = (shift); | |
100 | |
101 $msg = sprintf($msg, @_) if (@_); | |
102 warn "$Dpkg::PROGNAME: $msg\n\n"; | |
103 warn "$printforhelp\n"; | |
104 exit(2); | |
105 } | |
106 | |
107 1; | |
OLD | NEW |