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 |